diff src/cjrize.sml @ 269:fac9fae654e2

Cjrize query
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 09:53:15 -0400
parents 7e9bd70ad3ce
children 42dfb0d61cf0
line wrap: on
line diff
--- a/src/cjrize.sml	Sun Aug 31 16:54:13 2008 -0400
+++ b/src/cjrize.sml	Tue Sep 02 09:53:15 2008 -0400
@@ -275,12 +275,63 @@
             ((L'.ESeq (e1, e2), loc), sm)
         end
 
-      | L.ELet _ => raise Fail "Cjrize ELet"
+      | L.ELet (x, t, e1, e2) =>
+        let
+            val (t, sm) = cifyTyp (t, sm)
+            val (e1, sm) = cifyExp (e1, sm)
+            val (e2, sm) = cifyExp (e2, sm)
+        in
+            ((L'.ELet (x, t, e1, e2), loc), sm)
+        end
 
       | L.EClosure _ => (ErrorMsg.errorAt loc "Nested closure remains in code generation";
                          (dummye, sm))
 
-      | L.EQuery _ => raise Fail "Cjrize EQuery"
+      | L.EQuery {exps, tables, state, query, body, initial} =>
+        let
+            val (exps', sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
+                                                    let
+                                                        val (t, sm) = cifyTyp (t, sm)
+                                                    in
+                                                        ((x, t), sm)
+                                                    end) sm exps
+            val (tables', sm) = ListUtil.foldlMap (fn ((x, xts), sm) =>
+                                                      let
+                                                          val (xts, sm) = ListUtil.foldlMap
+                                                                              (fn ((x, t), sm) =>
+                                                                                  let
+                                                                                      val (t, sm) = cifyTyp (t, sm)
+                                                                                  in
+                                                                                      ((x, t), sm)
+                                                                                  end) sm xts
+                                                      in
+                                                          ((x, xts), sm)
+                                                      end) sm tables
+
+            val row = exps @ map (fn (x, xts) => (x, (L.TRecord xts, loc))) tables
+            val row = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row
+
+            val (tableRows, sm) = ListUtil.foldlMap (fn (((x, xts), (_, xts')), sm) =>
+                                                        let
+                                                            val (sm, rnum) = Sm.find (sm, xts, xts')
+                                                        in
+                                                            ((x, rnum), sm)
+                                                        end)
+                                                    sm (ListPair.zip (tables, tables'))
+            val row' = exps' @ map (fn (x, n) => (x, (L'.TRecord n, loc))) tableRows
+            val row' = ListMergeSort.sort (fn ((x, _), (y, _)) => String.compare (x, y) = GREATER) row'
+
+            val (sm, rnum) = Sm.find (sm, row, row')
+
+            val (state, sm) = cifyTyp (state, sm)
+            val (query, sm) = cifyExp (query, sm)
+            val (body, sm) = cifyExp (body, sm)
+            val (initial, sm) = cifyExp (initial, sm)
+        in
+            ((L'.EQuery {exps = exps', tables = tables', rnum = rnum, state = state,
+                         query = query, body = body, initial = initial}, loc), sm)
+        end
+
 
 fun cifyDecl ((d, loc), sm) =
     case d of