diff src/elab_env.sml @ 174:7ee424760d2f

Elaborating module constructor patterns; parsing record patterns
author Adam Chlipala <adamc@hcoop.net>
date Thu, 31 Jul 2008 11:28:55 -0400
parents c7a6e6dbc318
children 88d46972de53
line wrap: on
line diff
--- a/src/elab_env.sml	Thu Jul 31 10:44:52 2008 -0400
+++ b/src/elab_env.sml	Thu Jul 31 11:28:55 2008 -0400
@@ -570,6 +570,25 @@
            | SOME (xncs, subs) => SOME (map (fn (x, n, to) => (x, n, Option.map (sgnSubCon (str, subs)) to)) xncs))
       | _ => NONE
 
+fun projectConstructor env {sgn, str, field} =
+    case #1 (hnormSgn env sgn) of
+        SgnConst sgis =>
+        let
+            fun consider (n, xncs) =
+                ListUtil.search (fn (x, n', to) =>
+                                    if x <> field then
+                                        NONE
+                                    else
+                                        SOME (n', to, (CNamed n, #2 str))) xncs
+        in
+            case sgnSeek (fn SgiDatatype (_, n, xncs) => consider (n, xncs)
+                           | SgiDatatypeImp (_, n, _, _, _, xncs) => consider (n, xncs)
+                           | _ => NONE) sgis of
+                NONE => NONE
+              | SOME ((n, to, t), subs) => SOME (n, Option.map (sgnSubCon (str, subs)) to, sgnSubCon (str, subs) t)
+        end
+      | _ => NONE
+
 fun projectVal env {sgn, str, field} =
     case #1 (hnormSgn env sgn) of
         SgnConst sgis =>