Matching values in signatures

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