diff options
| -rw-r--r-- | src/compiler.sml | 3 | ||||
| -rw-r--r-- | src/elab_print.sml | 13 | ||||
| -rw-r--r-- | src/elaborate.sml | 14 | ||||
| -rw-r--r-- | tests/modules.lac | 31 |
4 files changed, 56 insertions, 5 deletions
diff --git a/src/compiler.sml b/src/compiler.sml index 9a213ab6..de644d37 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -132,7 +132,8 @@ fun testElaborate filename = (case elaborate ElabEnv.basis filename of NONE => print "Failed\n" | SOME (file, _) => - (Print.print (ElabPrint.p_file ElabEnv.basis file); + (print "Succeeded\n"; + Print.print (ElabPrint.p_file ElabEnv.basis file); print "\n")) handle ElabEnv.UnboundNamed n => print ("Unbound named " ^ Int.toString n ^ "\n") diff --git a/src/elab_print.sml b/src/elab_print.sml index c07631a0..435ea13d 100644 --- a/src/elab_print.sml +++ b/src/elab_print.sml @@ -275,7 +275,14 @@ and p_sgn env (sgn, _) = case sgn of SgnConst sgis => box [string "sig", newline, - p_list_sep newline (p_sgn_item env) sgis, + let + val (psgis, _) = ListUtil.foldlMap (fn (sgi, env) => + (p_sgn_item env sgi, + E.sgiBinds env sgi)) + env sgis + in + p_list_sep newline (fn x => x) psgis + end, newline, string "end"] | SgnVar n => string (#1 (E.lookupSgnNamed env n)) @@ -329,13 +336,13 @@ and p_str env (str, _) = case str of StrConst ds => box [string "struct", newline, - p_list_sep newline (p_decl env) ds, + p_file env ds, newline, string "end"] | StrVar n => string (#1 (E.lookupStrNamed env n)) | StrError => string "<ERROR>" -fun p_file env file = +and p_file env file = let val (pds, _) = ListUtil.foldlMap (fn (d, env) => (p_decl env d, diff --git a/src/elaborate.sml b/src/elaborate.sml index 3cdb2d9f..c61a84c1 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -1072,12 +1072,24 @@ fun subSgn env (all1 as (sgn1, _)) (all2 as (sgn2, loc2)) = end | _ => NONE) + | L'.SgiVal (x, n2, c2) => + seek (fn sgi1All as (sgi1, _) => + case sgi1 of + L'.SgiVal (x, n1, c1) => + let + val () = unifyCons env c1 c2 + handle CUnify (c1, c2, err) => + sgnError env (SgiWrongCon (sgi1All, c1, sgi2All, c2, err)) + in + SOME env + end + | _ => NONE) + | _ => raise Fail "Not ready for more sig matching" end in ignore (foldl folder env sgis2) end - fun elabDecl ((d, loc), env) = let diff --git a/tests/modules.lac b/tests/modules.lac index 9d5fbc90..1bdc685c 100644 --- a/tests/modules.lac +++ b/tests/modules.lac @@ -26,3 +26,34 @@ structure C = struct end structure CoB1 : B1 = C (*structure CoB2 : B2 = C*) + + +signature NAT = sig + type t + val zero : t +end +structure Nat : NAT = struct + type t = int + val zero = 0 +end +(*structure NotNat : NAT = struct + type t = int + val zero = 0.0 +end*) +(*structure NotNat : NAT = struct + val zero = 0 +end*) + + +signature WOBBLE = sig + type t + type s +end +structure Wobble1 = struct + type t = int + type s = float +end +structure Wobble2 = struct + type s = int + type t = float +end |