diff src/elab_util.sml @ 447:b77863cd0be2

Elaborating 'let'
author Adam Chlipala <adamc@hcoop.net>
date Sat, 01 Nov 2008 11:17:29 -0400
parents dfc8c991abd0
children 85819353a84f
line wrap: on
line diff
--- a/src/elab_util.sml	Sat Nov 01 10:47:10 2008 -0400
+++ b/src/elab_util.sml	Sat Nov 01 11:17:29 2008 -0400
@@ -352,6 +352,48 @@
               | EError => S.return2 eAll
               | EUnif (ref (SOME e)) => mfe ctx e
               | EUnif _ => S.return2 eAll
+
+              | ELet (des, e) =>
+                let
+                    val (des, ctx) = foldl (fn (ed, (des, ctx)) =>
+                                                (S.bind2 (des,
+                                                       fn des' =>
+                                                          S.map2 (mfed ctx ed,
+                                                               fn ed' => des' @ [ed'])),
+                                                 case #1 ed of
+                                                     EDVal (x, t, _) => bind (ctx, RelE (x, t))
+                                                   | EDValRec vis =>
+                                                     foldl (fn ((x, t, _), env) => bind (ctx, RelE (x, t))) ctx vis))
+                                            (S.return2 [], ctx) des
+                in
+                    S.bind2 (des,
+                         fn des' =>
+                            S.map2 (mfe ctx e,
+                                    fn e' =>
+                                       (ELet (des', e'), loc)))
+                end
+
+        and mfed ctx (dAll as (d, loc)) =
+            case d of
+                EDVal vi =>
+                S.map2 (mfvi ctx vi,
+                     fn vi' =>
+                        (EDVal vi', loc))
+              | EDValRec vis =>
+                let
+                    val ctx = foldl (fn ((x, t, _), env) => bind (ctx, RelE (x, t))) ctx vis
+                in
+                    S.map2 (ListUtil.mapfold (mfvi ctx) vis,
+                         fn vis' =>
+                            (EDValRec vis', loc))
+                end
+
+        and mfvi ctx (x, c, e) =
+            S.bind2 (mfc ctx c,
+                  fn c' =>
+                     S.map2 (mfe ctx e,
+                          fn e' =>
+                             (x, c', e')))
     in
         mfe
     end