# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1214751938 14400
# Node ID a6d45c6819c97bcd3438cafbd12cd09900400473
# Parent  a1026ae076ea200826a80fcb9b3b8ef9b168aff4
Implicit structure members

diff -r a1026ae076ea -r a6d45c6819c9 src/elaborate.sml
--- a/src/elaborate.sml	Sun Jun 29 10:44:36 2008 -0400
+++ b/src/elaborate.sml	Sun Jun 29 11:05:38 2008 -0400
@@ -1569,13 +1569,56 @@
       | L.DStr (x, sgno, str) =>
         let
             val formal = Option.map (elabSgn env) sgno
-            val (str', actual) = elabStr env str
 
-            val sgn' = case formal of
-                           NONE => selfifyAt env {str = str', sgn = actual}
-                         | SOME formal =>
-                           (subSgn env actual formal;
-                            formal)
+            val (str', sgn') =
+                case formal of
+                    NONE =>
+                    let
+                        val (str', actual) = elabStr env str
+                    in
+                        (str', selfifyAt env {str = str', sgn = actual})
+                    end
+                  | SOME formal =>
+                    let
+                        val str =
+                            case #1 (hnormSgn env formal) of
+                                L'.SgnConst sgis =>
+                                (case #1 str of
+                                     L.StrConst ds =>
+                                     let
+                                         val needed = foldl (fn ((sgi, _), needed) =>
+                                                                case sgi of
+                                                                    L'.SgiConAbs (x, _, _) => SS.add (needed, x)
+                                                                  | _ => needed)
+                                                            SS.empty sgis
+                                                      
+                                         val needed = foldl (fn ((d, _), needed) =>
+                                                                case d of
+                                                                    L.DCon (x, _, _) => (SS.delete (needed, x)
+                                                                                         handle NotFound => needed)
+                                                                  | L.DOpen _ => SS.empty
+                                                                  | _ => needed)
+                                                            needed ds
+                                     in
+                                         case SS.listItems needed of
+                                             [] => str
+                                           | xs =>
+                                             let
+                                                 val kwild = (L.KWild, #2 str)
+                                                 val cwild = (L.CWild kwild, #2 str)
+                                                 val ds' = map (fn x => (L.DCon (x, NONE, cwild), #2 str)) xs
+                                             in
+                                                 (L.StrConst (ds @ ds'), #2 str)
+                                             end
+                                     end
+                                   | _ => str)
+                              | _ => str
+
+                        val (str', actual) = elabStr env str
+                    in
+                        subSgn env actual formal;
+                        (str', formal)
+                    end
 
             val (env', n) = E.pushStrNamed env x sgn'
         in
diff -r a1026ae076ea -r a6d45c6819c9 tests/sig_impl.lac
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/sig_impl.lac	Sun Jun 29 11:05:38 2008 -0400
@@ -0,0 +1,27 @@
+signature S = sig
+        type t
+        val x : t
+end
+
+structure M : S = struct
+        val x = 0
+end
+
+signature S = sig
+        con r :: {Type}
+        val x : $r
+end
+
+structure M : S = struct
+        val x = {A = 0, B = "Hi"}
+end
+
+signature S = sig
+        type t
+        con r :: {Type}
+        val x : t -> $r
+end
+
+structure M : S = struct
+        val x = fn v : int => {A = 0, B = "Hi"}
+end