# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1312490645 14400
# Node ID cccf8bf64b30ca1ab32406f0e2a60453ba5325e2
# Parent  b5d78407886dfbcdc8dc0cef0f7934306e650b8d
Fix opening of shadowing, principal-signatured modules that open other modules

diff -r b5d78407886d -r cccf8bf64b30 src/corify.sml
--- a/src/corify.sml	Tue Aug 02 20:17:41 2011 -0400
+++ b/src/corify.sml	Thu Aug 04 16:44:05 2011 -0400
@@ -212,7 +212,7 @@
         FFfi {mod = m, ...} => CFfi m
       | FNormal {cons, ...} =>
         case SM.find (cons, x) of
-            NONE => raise Fail "Corify.St.lookupConByName"
+            NONE => raise Fail ("Corify.St.lookupConByName " ^ x)
           | SOME n => CNormal n
 
 fun bindVal {basis, cons, constructors, vals, strs, funs, current, nested} s n =
@@ -275,7 +275,7 @@
            | SOME t => EFfi (m, t))
       | FNormal {name, vals, ...} =>
         case SM.find (vals, x) of
-            NONE => raise Fail ("Corify.St.lookupValByName " ^ String.concatWith "." name ^ "." ^ x)
+            NONE => raise Fail ("Corify.St.lookupValByName " ^ String.concatWith "." (rev name) ^ "." ^ x)
           | SOME n => ENormal n
 
 fun bindConstructor {basis, cons, constructors, vals, strs, funs, current, nested} s n n' =
diff -r b5d78407886d -r cccf8bf64b30 src/elaborate.sml
--- a/src/elaborate.sml	Tue Aug 02 20:17:41 2011 -0400
+++ b/src/elaborate.sml	Thu Aug 04 16:44:05 2011 -0400
@@ -2723,6 +2723,8 @@
 
 and dopen env {str, strs, sgn} =
     let
+        fun isVisible x = x <> "" andalso String.sub (x, 0) <> #"?"
+
         val m = foldl (fn (m, str) => (L'.StrProj (str, m), #2 sgn))
                 (L'.StrVar str, #2 sgn) strs
     in
@@ -2734,37 +2736,64 @@
                         val d =
                             case sgi of
                                 L'.SgiConAbs (x, n, k) =>
-                                let
-                                    val c = (L'.CModProj (str, strs, x), loc)
-                                in
-                                    [(L'.DCon (x, n, k, c), loc)]
-                                end
+                                if isVisible x then
+                                    let
+                                        val c = (L'.CModProj (str, strs, x), loc)
+                                    in
+                                        [(L'.DCon (x, n, k, c), loc)]
+                                    end
+                                else
+                                    []
                               | L'.SgiCon (x, n, k, c) =>
-                                [(L'.DCon (x, n, k, (L'.CModProj (str, strs, x), loc)), loc)]
+                                if isVisible x then
+                                    [(L'.DCon (x, n, k, (L'.CModProj (str, strs, x), loc)), loc)]
+                                else
+                                    []
                               | L'.SgiDatatype dts =>
-                                map (fn (x, n, xs, xncs) => (L'.DDatatypeImp (x, n, str, strs, x, xs, xncs), loc)) dts
+                                List.mapPartial (fn (x, n, xs, xncs) => if isVisible x then
+                                                                            SOME (L'.DDatatypeImp (x, n, str, strs, x, xs, xncs), loc)
+                                                                        else
+                                                                            NONE) dts
                               | L'.SgiDatatypeImp (x, n, m1, ms, x', xs, xncs) =>
-                                [(L'.DDatatypeImp (x, n, m1, ms, x', xs, xncs), loc)]
+                                if isVisible x then
+                                    [(L'.DDatatypeImp (x, n, m1, ms, x', xs, xncs), loc)]
+                                else
+                                    []
                               | L'.SgiVal (x, n, t) =>
-                                [(L'.DVal (x, n, t, (L'.EModProj (str, strs, x), loc)), loc)]
+                                if isVisible x then
+                                    [(L'.DVal (x, n, t, (L'.EModProj (str, strs, x), loc)), loc)]
+                                else
+                                    []
                               | L'.SgiStr (x, n, sgn) =>
-                                [(L'.DStr (x, n, sgn, (L'.StrProj (m, x), loc)), loc)]
+                                if isVisible x then
+                                    [(L'.DStr (x, n, sgn, (L'.StrProj (m, x), loc)), loc)]
+                                else
+                                    []
                               | L'.SgiSgn (x, n, sgn) =>
-                                [(L'.DSgn (x, n, (L'.SgnProj (str, strs, x), loc)), loc)]
+                                if isVisible x then
+                                    [(L'.DSgn (x, n, (L'.SgnProj (str, strs, x), loc)), loc)]
+                                else
+                                    []
                               | L'.SgiConstraint (c1, c2) =>
                                 [(L'.DConstraint (c1, c2), loc)]
                               | L'.SgiClassAbs (x, n, k) =>
-                                let
-                                    val c = (L'.CModProj (str, strs, x), loc)
-                                in
-                                    [(L'.DCon (x, n, k, c), loc)]
-                                end
+                                if isVisible x then
+                                    let
+                                        val c = (L'.CModProj (str, strs, x), loc)
+                                    in
+                                        [(L'.DCon (x, n, k, c), loc)]
+                                    end
+                                else
+                                    []
                               | L'.SgiClass (x, n, k, _) =>
-                                let
-                                    val c = (L'.CModProj (str, strs, x), loc)
-                                in
-                                    [(L'.DCon (x, n, k, c), loc)]
-                                end
+                                if isVisible x then
+                                    let
+                                        val c = (L'.CModProj (str, strs, x), loc)
+                                    in
+                                        [(L'.DCon (x, n, k, c), loc)]
+                                    end
+                                else
+                                    []
                     in
                         (d, foldl (fn (d, env') => E.declBinds env' d) env' d)
                     end)
diff -r b5d78407886d -r cccf8bf64b30 tests/openRedef.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/openRedef.ur	Thu Aug 04 16:44:05 2011 -0400
@@ -0,0 +1,16 @@
+structure M = struct
+    con num = int
+    val zero = 0
+end
+
+structure N = struct
+    open M
+    con num = num * num
+    val zero = zero + 1
+end
+
+structure O = struct
+    open N
+
+    val one : num = (zero + 1, zero)
+end