# HG changeset patch # User Adam Chlipala # Date 1263312459 18000 # Node ID c01fb6f1b31fc029918670744d38b2c384be57c4 # Parent e06bfeb6c2aaf7c1a853c17ecd07fbe4c3c21999 -path and -root command-line flags diff -r e06bfeb6c2aa -r c01fb6f1b31f src/compiler.sml --- 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 diff -r e06bfeb6c2aa -r c01fb6f1b31f src/corify.sml --- 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 diff -r e06bfeb6c2aa -r c01fb6f1b31f src/main.mlton.sml --- 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) diff -r e06bfeb6c2aa -r c01fb6f1b31f tests/paths.urp --- /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 diff -r e06bfeb6c2aa -r c01fb6f1b31f tests/paths1.ur --- /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 diff -r e06bfeb6c2aa -r c01fb6f1b31f tests/paths2.ur --- /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 {[Tests.Paths1.it]} diff -r e06bfeb6c2aa -r c01fb6f1b31f tests/paths2.urs --- /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