From 38bb7bdbdfdb9c180e7d47ac3885673a464539de Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 4 Feb 2010 16:29:09 -0500
Subject: Fixes for rooted modules

---
 src/compiler.sml | 59 +++++++++++++++++++++++++++++++++++++++++++++++++-------
 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]"
 
-- 
cgit v1.2.3