# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1213306551 14400
# Node ID 0ff8c27286346788afafa3dfd19a2ebfe091a3b7
# Parent  1c91c5e6840f5c320ea36389069ce70e2709ae7b
Matching values in signatures

diff -r 1c91c5e6840f -r 0ff8c2728634 src/compiler.sml
--- 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")
diff -r 1c91c5e6840f -r 0ff8c2728634 src/elab_print.sml
--- 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,
diff -r 1c91c5e6840f -r 0ff8c2728634 src/elaborate.sml
--- 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
diff -r 1c91c5e6840f -r 0ff8c2728634 tests/modules.lac
--- 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