# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1220363595 14400
# Node ID fac9fae654e290959654d50863e644717dfd614c
# Parent  bacd0ba869e1a1292ae4c89918891996165bf180
Cjrize query

diff -r bacd0ba869e1 -r fac9fae654e2 src/cjr.sml
--- a/src/cjr.sml	Sun Aug 31 16:54:13 2008 -0400
+++ b/src/cjr.sml	Tue Sep 02 09:53:15 2008 -0400
@@ -32,8 +32,7 @@
 datatype datatype_kind = datatype Mono.datatype_kind
 
 datatype typ' =
-         TTop
-       | TFun of typ * typ
+         TFun of typ * typ
        | TRecord of int
        | TDatatype of datatype_kind * int * (string * int * typ option) list ref
        | TFfi of string * string
@@ -69,6 +68,15 @@
 
        | EWrite of exp
        | ESeq of exp * exp
+       | ELet of string * typ * exp * exp
+
+       | EQuery of { exps : (string * typ) list,
+                     tables : (string * (string * typ) list) list,
+                     rnum : int,
+                     state : typ,
+                     query : exp,
+                     body : exp,
+                     initial : exp }
 
 withtype exp = exp' located
 
diff -r bacd0ba869e1 -r fac9fae654e2 src/cjr_print.sml
--- a/src/cjr_print.sml	Sun Aug 31 16:54:13 2008 -0400
+++ b/src/cjr_print.sml	Tue Sep 02 09:53:15 2008 -0400
@@ -34,6 +34,8 @@
 
 open Cjr
 
+val dummyt = (TRecord 0, ErrorMsg.dummySpan)
+
 structure E = CjrEnv
 structure EM = ErrorMsg
 
@@ -57,8 +59,7 @@
 
 fun p_typ' par env (t, loc) =
     case t of
-        TTop => string "void*"
-      | TFun (t1, t2) => parenIf par (box [p_typ' true env t2,
+        TFun (t1, t2) => parenIf par (box [p_typ' true env t2,
                                            space,
                                            string "(*)",
                                            space,
@@ -528,6 +529,48 @@
                               space,
                               p_exp env e2,
                               string ")"]
+      | ELet (x, t, e1, e2) => box [string "({",
+                                    newline,
+                                    p_typ env t,
+                                    space,
+                                    p_rel env 0,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_exp env e1,
+                                    string ";",
+                                    newline,
+                                    p_exp (E.pushERel env x t) e2,
+                                    string ";",
+                                    newline,
+                                    string "})"]
+
+      | EQuery {exps, tables, rnum, state, query, body, initial} =>
+        box [string "query[",
+             p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) exps,
+             string "] [",
+             p_list (fn (x, xts) => box [string x,
+                                         space,
+                                         string ":",
+                                         space,
+                                         string "{",
+                                         p_list (fn (x, t) => box [string x, space, string ":", space, p_typ env t]) xts,
+                                         string "}"]) tables,
+             string "] [",
+             p_typ env state,
+             string "] [",
+             string (Int.toString rnum),
+             string "]",
+             space,
+             p_exp env query,
+             space,
+             string "initial",
+             space,
+             p_exp env initial,
+             space,
+             string "in",
+             space,
+             p_exp (E.pushERel (E.pushERel env "r" dummyt) "acc" dummyt) body]
 
 and p_exp env = p_exp' false env
 
diff -r bacd0ba869e1 -r fac9fae654e2 src/cjrize.sml
--- 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