From 4acc576d52308431a4d0311e8b37984ab3d0b0bc Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 24 Dec 2009 15:49:52 -0500
Subject: Convenience libifying; allow more NULLs with globals

---
 src/c/urweb.c    |  9 ++++-----
 src/compiler.sig |  2 ++
 src/compiler.sml | 24 +++++++++++++++++++++---
 3 files changed, 27 insertions(+), 8 deletions(-)

(limited to 'src')

diff --git a/src/c/urweb.c b/src/c/urweb.c
index 1f8271d5..4a0306e0 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -468,7 +468,8 @@ void uw_free(uw_context ctx) {
     buf_free(&ctx->deltas[i].msgs);
 
   for (i = 0; i < ctx->n_globals; ++i)
-    ctx->globals[i].free(ctx->globals[i].data);
+    if (ctx->globals[i].free)
+      ctx->globals[i].free(ctx->globals[i].data);
 
   free(ctx);
 }
@@ -3177,17 +3178,15 @@ void *uw_get_global(uw_context ctx, char *name) {
 void uw_set_global(uw_context ctx, char *name, void *data, void (*free)(void*)) {
   int i;
 
-  if (data == NULL) uw_error(ctx, FATAL, "NULL data value for global '%s'", name);
-
   for (i = 0; i < ctx->n_globals; ++i)
     if (!strcmp(name, ctx->globals[i].name)) {
-      if (ctx->globals[i].data)
+      if (ctx->globals[i].free)
         ctx->globals[i].free(ctx->globals[i].data);
       ctx->globals[i].data = data;
       ctx->globals[i].free = free;
       return;
     }
-      
+
   ++ctx->n_globals;
   ctx->globals = realloc(ctx->globals, ctx->n_globals * sizeof(global));
   ctx->globals[ctx->n_globals-1].name = name;
diff --git a/src/compiler.sig b/src/compiler.sig
index e34b771e..fbc3011e 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -156,4 +156,6 @@ signature COMPILER = sig
 
     val debug : bool ref
 
+    val addPath : string * string -> unit
+
 end
diff --git a/src/compiler.sml b/src/compiler.sml
index fc764205..b793ab60 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -270,9 +270,13 @@ structure M = BinaryMapFn(struct
                           val compare = String.compare
                           end)
 
+val pathmap = ref (M.insert (M.empty, "", Config.libUr))
+
+fun addPath (k, v) = pathmap := M.insert (!pathmap, k, v)
+
 fun parseUrp' accLibs fname =
     let
-        val pathmap = ref (M.insert (M.empty, "", Config.libUr))
+        val pathmap = ref (!pathmap)
         val bigLibs = ref []
 
         fun pu filename =
@@ -304,6 +308,20 @@ fun parseUrp' accLibs fname =
                         handle OS.Path.Path => fname
                     end
 
+                fun libify path =
+                    (if Posix.FileSys.access (path ^ ".urp", []) then
+                         path
+                     else
+                         path ^ "/lib")
+                    handle SysErr => path
+
+                fun libify' path =
+                    (if Posix.FileSys.access (relify path ^ ".urp", []) then
+                         path
+                     else
+                         path ^ "/lib")
+                    handle SysErr => path
+
                 val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
 
                 fun relifyA fname =
@@ -559,9 +577,9 @@ fun parseUrp' accLibs fname =
                                      end
                                    | _ => ErrorMsg.error "Bad 'deny' syntax")
                               | "library" => if accLibs then
-                                                 libs := pu (relify arg) :: !libs
+                                                 libs := pu (libify (relify arg)) :: !libs
                                              else
-                                                 bigLibs := arg :: !bigLibs
+                                                 bigLibs := libify' arg :: !bigLibs
                               | "path" =>
                                 (case String.fields (fn ch => ch = #"=") arg of
                                      [n, v] => pathmap := M.insert (!pathmap, n, v)
-- 
cgit v1.2.3