diff src/mono_print.sml @ 252:7e9bd70ad3ce

Monoized and optimized initial query test
author Adam Chlipala <adamc@hcoop.net>
date Sun, 31 Aug 2008 13:58:47 -0400
parents 326fb4686f60
children 42dfb0d61cf0
line wrap: on
line diff
--- a/src/mono_print.sml	Sun Aug 31 10:36:54 2008 -0400
+++ b/src/mono_print.sml	Sun Aug 31 13:58:47 2008 -0400
@@ -38,6 +38,8 @@
 
 val debug = ref false
 
+val dummyt = (TRecord [], ErrorMsg.dummySpan)
+
 fun p_typ' par env (t, _) =
     case t of
         TFun (t1, t2) => parenIf par (box [p_typ' true env t1,
@@ -133,17 +135,17 @@
       | EApp (e1, e2) => parenIf par (box [p_exp env e1,
                                            space,
                                            p_exp' true env e2])
-      | EAbs (x, t, _, e) => parenIf par (box [string "fn",
-                                               space,
-                                               string x,
-                                               space,
-                                               string ":",
-                                               space,
-                                               p_typ env t,
-                                               space,
-                                               string "=>",
-                                               space,
-                                               p_exp (E.pushERel env x t NONE) e])
+      | EAbs (x, t, _, e) => parenIf true (box [string "fn",
+                                                space,
+                                                string x,
+                                                space,
+                                                string ":",
+                                                space,
+                                                p_typ env t,
+                                                space,
+                                                string "=>",
+                                                space,
+                                                p_exp (E.pushERel env x t NONE) e])
 
       | ERecord xes => box [string "{",
                             p_list (fn (x, e, _) =>
@@ -158,18 +160,18 @@
              string ".",
              string x]
 
-      | ECase (e, pes, _) => parenIf par (box [string "case",
-                                               space,
-                                               p_exp env e,
-                                               space,
-                                               string "of",
-                                               space,
-                                               p_list_sep (box [space, string "|", space])
-                                                          (fn (p, e) => box [p_pat env p,
-                                                                             space,
-                                                                             string "=>",
-                                                                             space,
-                                                                             p_exp (E.patBinds env p) e]) pes])
+      | ECase (e, pes, _) => parenIf true (box [string "case",
+                                                space,
+                                                p_exp env e,
+                                                space,
+                                                string "of",
+                                                space,
+                                                p_list_sep (box [space, string "|", space])
+                                                           (fn (p, e) => box [p_pat env p,
+                                                                              space,
+                                                                              string "=>",
+                                                                              space,
+                                                                              p_exp (E.patBinds env p) e]) pes])
 
       | EStrcat (e1, e2) => box [p_exp' true env e1,
                                  space,
@@ -185,7 +187,7 @@
                               string ";",
                               space,
                               p_exp env e2]
-      | ELet (x, t, e1, e2) => box [string "let",
+      | ELet (x, t, e1, e2) => box [string "(let",
                                     space,
                                     string x,
                                     space,
@@ -195,11 +197,15 @@
                                     space,
                                     string "=",
                                     space,
+                                    string "(",
                                     p_exp env e1,
+                                    string ")",
                                     space,
                                     string "in",
                                     space,
-                                    p_exp (E.pushERel env x t NONE) e2]
+                                    string "(",
+                                    p_exp (E.pushERel env x t NONE) e2,
+                                    string "))"]
 
       | EClosure (n, es) => box [string "CLOSURE(",
                                  p_enamed env n,
@@ -207,6 +213,31 @@
                                                                       p_exp env e]) es,
                                  string ")"]
 
+      | EQuery {exps, tables, 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 "]",
+             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 NONE) "acc" dummyt NONE) body]
+
 and p_exp env = p_exp' false env
 
 fun p_vali env (x, n, t, e, s) =