Mercurial > urweb
changeset 1146:7fdea74b1dd9
Fixes for rooted modules
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 04 Feb 2010 16:29:09 -0500 |
| parents | 6249df767d4c |
| children | 92f37d58828b |
| files | src/compiler.sml src/corify.sml |
| diffstat | 2 files changed, 54 insertions(+), 9 deletions(-) [+] |
line wrap: on
line diff
--- a/src/compiler.sml Thu Feb 04 13:07:12 2010 -0500 +++ b/src/compiler.sml Thu Feb 04 16:29:09 2010 -0500 @@ -730,17 +730,54 @@ | [_] => d | piece :: pieces => let - val this = prefix ^ "." ^ piece + val this = case prefix of + "" => piece + | _ => prefix ^ "." ^ piece val old = SS.member (!defed, this) + + fun notThere (ch, s) = + Substring.isEmpty (#2 (Substring.splitl + (fn ch' => ch' <> ch) s)) + + fun simOpen () = + SS.foldl (fn (full, ds) => + if String.isPrefix (this ^ ".") full + andalso notThere (#".", + Substring.extract (full, + size + this + 1, + NONE)) then + let + val parts = String.tokens + (fn ch => ch = #".") full + + val part = List.last parts + + val imp = if length parts >= 2 then + (Source.StrProj + ((Source.StrVar + (List.nth (parts, + length + parts + - 2)), + loc), + part), loc) + else + (Source.StrVar part, loc) + in + (Source.DStr (part, NONE, imp), + loc) :: ds + end + else + ds) [] (!fulls) in defed := SS.add (!defed, this); (Source.DStr (piece, NONE, (Source.StrConst (if old then - [(Source.DOpen (piece, []), - loc), - makeD prefix pieces] + simOpen () + @ [makeD this pieces] else - [makeD prefix pieces]), loc)), + [makeD this pieces]), loc)), loc) end in @@ -748,9 +785,17 @@ ErrorMsg.error ("Rooted module " ^ full ^ " has multiple versions.") else (); - fulls := SS.add (!fulls, full); - + makeD "" pieces + before ignore (foldl (fn (new, path) => + let + val new' = case path of + "" => new + | _ => path ^ "." ^ new + in + fulls := SS.add (!fulls, new'); + new' + end) "" pieces) end in checkErrors ();
--- a/src/corify.sml Thu Feb 04 13:07:12 2010 -0500 +++ b/src/corify.sml Thu Feb 04 16:29:09 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 @@ -428,7 +428,7 @@ fun lookupFunctorByName (m, {current = FNormal {funs, ...}, ...} : t) = (case SM.find (funs, m) of - NONE => raise Fail "Corify.St.lookupFunctorByName [1]" + NONE => raise Fail ("Corify.St.lookupFunctorByName " ^ m ^ "[1]") | SOME v => v) | lookupFunctorByName _ = raise Fail "Corify.St.lookupFunctorByName [2]"