Mercurial > urweb
changeset 32:0ff8c2728634
Matching values in signatures
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 12 Jun 2008 17:35:51 -0400 |
parents | 1c91c5e6840f |
children | 535c324f0b35 |
files | src/compiler.sml src/elab_print.sml src/elaborate.sml tests/modules.lac |
diffstat | 4 files changed, 56 insertions(+), 5 deletions(-) [+] |
line wrap: on
line diff
--- a/src/compiler.sml Thu Jun 12 17:16:20 2008 -0400 +++ b/src/compiler.sml Thu Jun 12 17:35:51 2008 -0400 @@ -132,7 +132,8 @@ (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")
--- a/src/elab_print.sml Thu Jun 12 17:16:20 2008 -0400 +++ b/src/elab_print.sml Thu Jun 12 17:35:51 2008 -0400 @@ -275,7 +275,14 @@ 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 @@ 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,
--- a/src/elaborate.sml Thu Jun 12 17:16:20 2008 -0400 +++ b/src/elaborate.sml Thu Jun 12 17:35:51 2008 -0400 @@ -1072,12 +1072,24 @@ 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
--- a/tests/modules.lac Thu Jun 12 17:16:20 2008 -0400 +++ b/tests/modules.lac Thu Jun 12 17:35:51 2008 -0400 @@ -26,3 +26,34 @@ 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