summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/compiler.sml18
-rw-r--r--src/corify.sml1
-rw-r--r--src/main.mlton.sml8
-rw-r--r--tests/paths.urp4
-rw-r--r--tests/paths1.ur1
-rw-r--r--tests/paths2.ur1
-rw-r--r--tests/paths2.urs1
7 files changed, 30 insertions, 4 deletions
diff --git a/src/compiler.sml b/src/compiler.sml
index 625d71ff..5fba9ae0 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -338,7 +338,7 @@ fun parseUrp' accLibs fname =
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 parse = {
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 @@ val parse = {
();
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
diff --git a/src/corify.sml b/src/corify.sml
index 26205e84..1637744e 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -1025,6 +1025,7 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) =
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
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 42f05259..9cf5064a 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -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 @@ fun doArgs args =
| "-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)
diff --git a/tests/paths.urp b/tests/paths.urp
new file mode 100644
index 00000000..7f3f6f0b
--- /dev/null
+++ b/tests/paths.urp
@@ -0,0 +1,4 @@
+debug
+
+$TESTS/paths1
+paths2
diff --git a/tests/paths1.ur b/tests/paths1.ur
new file mode 100644
index 00000000..cf06999f
--- /dev/null
+++ b/tests/paths1.ur
@@ -0,0 +1 @@
+val it = 1
diff --git a/tests/paths2.ur b/tests/paths2.ur
new file mode 100644
index 00000000..cdff1149
--- /dev/null
+++ b/tests/paths2.ur
@@ -0,0 +1 @@
+val main = return <xml>{[Tests.Paths1.it]}</xml>
diff --git a/tests/paths2.urs b/tests/paths2.urs
new file mode 100644
index 00000000..61778b87
--- /dev/null
+++ b/tests/paths2.urs
@@ -0,0 +1 @@
+val main : transaction page