diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2010-02-04 16:29:09 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2010-02-04 16:29:09 -0500 |
| commit | 282ff7d141e835d51f7eaa2952ba7913ebd5c6c1 (patch) | |
| tree | a7322dfab5d5ea651665f739f8e4b7b252775cd5 | |
| parent | 8386bf91f5cda763364eae726d64b035fa7dd40f (diff) | |
Fixes for rooted modules
| -rw-r--r-- | src/compiler.sml | 59 | ||||
| -rw-r--r-- | src/corify.sml | 4 |
2 files changed, 54 insertions, 9 deletions
diff --git a/src/compiler.sml b/src/compiler.sml index 11192dfa..e72d8b4b 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -730,17 +730,54 @@ val parse = { | [_] => 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 @@ val parse = { 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 (); diff --git a/src/corify.sml b/src/corify.sml index 1637744e..6931600e 100644 --- a/src/corify.sml +++ b/src/corify.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 @@ -428,7 +428,7 @@ fun lookupFunctorById ({funs, ...} : t) n = 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]" |