diff src/elab_util.sml @ 59:abb2b32c19fb

Subsignatures
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Jun 2008 19:10:38 -0400
parents b3fbbc6cb1e5
children 9f89f0b00b84
line wrap: on
line diff
--- a/src/elab_util.sml	Sun Jun 22 18:17:21 2008 -0400
+++ b/src/elab_util.sml	Sun Jun 22 19:10:38 2008 -0400
@@ -305,6 +305,7 @@
          RelC of string * Elab.kind
        | NamedC of string * Elab.kind
        | Str of string * Elab.sgn
+       | Sgn of string * Elab.sgn
 
 fun mapfoldB {kind, con, sgn_item, sgn, bind} =
     let
@@ -343,6 +344,10 @@
                 S.map2 (sg ctx s,
                      fn s' =>
                         (SgiStr (x, n, s'), loc))
+              | SgiSgn (x, n, s) =>
+                S.map2 (sg ctx s,
+                     fn s' =>
+                        (SgiSgn (x, n, s'), loc))
 
         and sg ctx s acc =
             S.bindP (sg' ctx s acc, sgn ctx)
@@ -358,7 +363,9 @@
                                                    bind (ctx, NamedC (x, k))
                                                  | SgiVal _ => ctx
                                                  | SgiStr (x, _, sgn) =>
-                                                   bind (ctx, Str (x, sgn)),
+                                                   bind (ctx, Str (x, sgn))
+                                                 | SgiSgn (x, _, sgn) =>
+                                                   bind (ctx, Sgn (x, sgn)),
                                                sgi ctx si)) ctx sgis,
                      fn sgis' =>
                         (SgnConst sgis', loc))
@@ -370,6 +377,7 @@
                             S.map2 (sg (bind (ctx, Str (m, s1'))) s2,
                                     fn s2' =>
                                        (SgnFun (m, n, s1', s2'), loc)))
+              | SgnProj _ => S.return2 sAll
               | SgnWhere (sgn, x, c) =>
                 S.bind2 (sg ctx sgn,
                       fn sgn' =>