# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1214485418 14400
# Node ID 2adb20eebee357f5ae21cc1504e4803a302102c2
# Parent  d609820c5834ac804a95e64116ef8c54013fb1af
Proper subsignaturing for sub-signatures

diff -r d609820c5834 -r 2adb20eebee3 src/elaborate.sml
--- a/src/elaborate.sml	Thu Jun 26 08:54:49 2008 -0400
+++ b/src/elaborate.sml	Thu Jun 26 09:03:38 2008 -0400
@@ -1353,9 +1353,18 @@
                                  case sgi1 of
                                      L'.SgiSgn (x', n1, sgn1) =>
                                      if x = x' then
-                                         (subSgn env sgn1 sgn2;
-                                          subSgn env sgn2 sgn1;
-                                          SOME env)
+                                         let
+                                             val () = subSgn env sgn1 sgn2
+                                             val () = subSgn env sgn2 sgn1
+
+                                             val env = E.pushSgnNamedAs env x n2 sgn2
+                                             val env = if n1 = n2 then
+                                                           env
+                                                       else
+                                                           E.pushSgnNamedAs env x n1 sgn2
+                                         in
+                                             SOME env
+                                         end
                                      else
                                          NONE
                                    | _ => NONE)
diff -r d609820c5834 -r 2adb20eebee3 tests/subs_sig.lac
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/subs_sig.lac	Thu Jun 26 09:03:38 2008 -0400
@@ -0,0 +1,7 @@
+signature S = sig
+        type t
+end
+
+structure S : S = struct
+        type t = int
+end
diff -r d609820c5834 -r 2adb20eebee3 tests/subs_sig.lig
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/subs_sig.lig	Thu Jun 26 09:03:38 2008 -0400
@@ -0,0 +1,5 @@
+signature S = sig
+        type t
+end
+
+structure S : S