Mercurial > urweb
diff src/compiler.sml @ 1868:d6b0ee53dc93
Get -root working properly again
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 26 Sep 2013 16:22:06 -0400 |
parents | 3683d1a8c1c8 |
children | c3119c263bd3 |
line wrap: on
line diff
--- a/src/compiler.sml Fri Sep 13 10:24:10 2013 -0400 +++ b/src/compiler.sml Thu Sep 26 16:22:06 2013 -0400 @@ -917,7 +917,10 @@ end) val moduleRoots = ref ([] : (string * string) list) -fun addModuleRoot (k, v) = moduleRoots := (k, v) :: !moduleRoots +fun addModuleRoot (k, v) = moduleRoots := + (OS.Path.mkAbsolute {path = k, + relativeTo = OS.FileSys.getDir ()}, + v) :: !moduleRoots structure SK = struct type ord_key = string @@ -998,7 +1001,7 @@ val ds = #func parseUr ur val d = (Source.DStr (mname, sgnO, if !Elaborate.incremental then SOME (if Time.> (urt, urst) then urt else urst) else NONE, - (Source.StrConst ds, loc)), loc) + (Source.StrConst ds, loc), false), loc) val fname = OS.Path.mkCanonical fname val d = case List.find (fn (root, name) => @@ -1014,7 +1017,7 @@ val pieces = map capitalize pieces val full = String.concatWith "." pieces - fun makeD prefix pieces = + fun makeD first prefix pieces = case pieces of [] => (ErrorMsg.error "Empty module path"; (Source.DStyle "Boo", loc)) @@ -1056,7 +1059,7 @@ else (Source.StrVar part, loc) in - (Source.DStr (part, NONE, NONE, imp), + (Source.DStr (part, NONE, NONE, imp, false), loc) :: ds end else @@ -1066,9 +1069,10 @@ (Source.DStr (piece, NONE, NONE, (Source.StrConst (if old then simOpen () - @ [makeD this pieces] + @ [makeD false this pieces] else - [makeD this pieces]), loc)), + [makeD false this pieces]), + loc), first andalso old), loc) end in @@ -1077,7 +1081,7 @@ else (); - makeD "" pieces + makeD true "" pieces before ignore (foldl (fn (new, path) => let val new' = case path of @@ -1131,10 +1135,17 @@ val ds = case onError of NONE => ds | SOME v => ds @ [(Source.DOnError v, loc)] + + fun dummy fname = {file = Settings.libFile fname, + first = ErrorMsg.dummyPos, + last = ErrorMsg.dummyPos} + + val used = SM.insert (SM.empty, "Basis", dummy "basis.urs") + val used = SM.insert (used, "Top", dummy "top.urs") in ignore (List.foldl (fn (d, used) => case #1 d of - Source.DStr (x, _, _, _) => + Source.DStr (x, _, _, _, false) => (case SM.find (used, x) of SOME loc => (ErrorMsg.error ("Duplicate top-level module name " ^ x); @@ -1143,7 +1154,7 @@ used) | NONE => SM.insert (used, x, #2 d)) - | _ => used) SM.empty ds); + | _ => used) used ds); ds end handle Empty => ds end,