changeset 1126:c01fb6f1b31f

-path and -root command-line flags
author Adam Chlipala <adamc@hcoop.net>
date Tue, 12 Jan 2010 11:07:39 -0500 (2010-01-12)
parents e06bfeb6c2aa
children f93dc2ea30c1
files src/compiler.sml src/corify.sml src/main.mlton.sml tests/paths.urp tests/paths1.ur tests/paths2.ur tests/paths2.urs
diffstat 7 files changed, 30 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/src/compiler.sml	Tue Jan 12 10:33:03 2010 -0500
+++ b/src/compiler.sml	Tue Jan 12 11:07:39 2010 -0500
@@ -338,7 +338,7 @@
                                           let
                                               val fname = String.implode (List.filter (fn x => not (Char.isSpace x))
                                                                                       (String.explode line))
-                                              val fname = relify fname
+                                              val fname = relifyA fname
                                           in
                                               fname :: acc
                                           end
@@ -709,6 +709,7 @@
                           val ds = #func parseUr ur
                           val d = (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
 
+                          val fname = OS.Path.mkCanonical fname
                           val d = case List.find (fn (root, name) =>
                                                      String.isPrefix (root ^ "/") fname) mrs of
                                       NONE => d
@@ -766,10 +767,21 @@
                       ();
 
                   let
-                      val final = nameOf (List.last fnames)
+                      val final = List.last fnames
+                      val final = case List.find (fn (root, name) =>
+                                                     String.isPrefix (root ^ "/") final) mrs of
+                                      NONE => (Source.StrVar (nameOf final), loc)
+                                    | SOME (root, name) =>
+                                      let
+                                          val m = (Source.StrVar name, loc)
+                                          val final = String.extract (final, size root + 1, NONE)
+                                      in
+                                          foldl (fn (x, m) => (Source.StrProj (m, capitalize x), loc))
+                                                m (String.fields (fn ch => ch = #"/") final)
+                                      end
 
                       val ds = dsFfi @ ds
-                               @ [(Source.DExport (Source.StrVar final, loc), loc)]
+                               @ [(Source.DExport final, loc)]
 
                       val ds = case database of
                                    NONE => ds
--- a/src/corify.sml	Tue Jan 12 10:33:03 2010 -0500
+++ b/src/corify.sml	Tue Jan 12 11:07:39 2010 -0500
@@ -1025,6 +1025,7 @@
                          val (wds, eds) = foldl wrapSgi ([], []) sgis
                          val wrapper = (L.StrConst wds, loc)
                          val mst = St.lookupStrById st m
+                         val mst = foldl St.lookupStrByName mst ms
                          val (ds, {inner, outer}) = corifyStr (St.name mst) (wrapper, st)
                          val st = St.bindStr outer "wrapper" en inner
                                   
--- a/src/main.mlton.sml	Tue Jan 12 10:33:03 2010 -0500
+++ b/src/main.mlton.sml	Tue Jan 12 11:07:39 2010 -0500
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -66,6 +66,12 @@
       | "-static" :: rest =>
         (Settings.setStaticLinking true;
          doArgs rest)
+      | "-path" :: name :: path :: rest =>
+        (Compiler.addPath (name, path);
+         doArgs rest)
+      | "-root" :: name :: root :: rest =>
+        (Compiler.addModuleRoot (root, name);
+         doArgs rest)
       | arg :: rest =>
         (if size arg > 0 andalso String.sub (arg, 0) = #"-" then
              raise Fail ("Unknown flag " ^ arg)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/paths.urp	Tue Jan 12 11:07:39 2010 -0500
@@ -0,0 +1,4 @@
+debug
+
+$TESTS/paths1
+paths2
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/paths1.ur	Tue Jan 12 11:07:39 2010 -0500
@@ -0,0 +1,1 @@
+val it = 1
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/paths2.ur	Tue Jan 12 11:07:39 2010 -0500
@@ -0,0 +1,1 @@
+val main = return <xml>{[Tests.Paths1.it]}</xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/paths2.urs	Tue Jan 12 11:07:39 2010 -0500
@@ -0,0 +1,1 @@
+val main : transaction page