diff options
| -rw-r--r-- | src/corify.sml | 4 | ||||
| -rw-r--r-- | src/elaborate.sml | 71 | ||||
| -rw-r--r-- | tests/openRedef.ur | 16 |
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 |