Fix opening of shadowing, principal-signatured modules that open other modules

3 files changed, 68 insertions, 23 deletions

diff --git a/src/corify.sml b/src/corify.sml
index 706a4c2d..d9e5d30c 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -212,7 +212,7 @@ fun lookupConByName ({current, ...} : t) x =
         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 @@ fun lookupValByName ({current, ...} : t) x =
            | 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 --git a/src/elaborate.sml b/src/elaborate.sml
index ed2e0d78..c043ef54 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2723,6 +2723,8 @@ and selfifyAt env {str, sgn} =
 
 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 @@ and dopen env {str, strs, sgn} =
                         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 --git a/tests/openRedef.ur b/tests/openRedef.ur
new file mode 100644
index 00000000..2d8161c3
--- /dev/null
+++ b/tests/openRedef.ur
@@ -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