diff src/cjr_print.sml @ 181:31dfab1d4050

Cjrize ECon
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 11:17:33 -0400
parents 25b169416ea8
children d11754ffe252
line wrap: on
line diff
--- a/src/cjr_print.sml	Sun Aug 03 11:03:35 2008 -0400
+++ b/src/cjr_print.sml	Sun Aug 03 11:17:33 2008 -0400
@@ -90,6 +90,51 @@
         EPrim p => Prim.p_t p
       | ERel n => p_rel env n
       | ENamed n => p_enamed env n
+      | ECon (n, eo) =>
+        let
+            val (x, _, dn) = E.lookupConstructor env n
+            val (dx, _) = E.lookupDatatype env dn
+        in
+            box [string "{(",
+                 newline,
+                 string "struct",
+                 space,
+                 string "__lwd_",
+                 string dx,
+                 string "_",
+                 string (Int.toString dn),
+                 space,
+                 string "*tmp",
+                 space,
+                 string "=",
+                 space,
+                 string "lw_malloc(ctx, sizeof(struct __lwd_",
+                 string dx,
+                 string "_",
+                 string (Int.toString dn),
+                 string "));",
+                 newline,
+                 string "tmp->tag",
+                 space,
+                 string "=",
+                 space,
+                 string ("__lwc_" ^ x ^ "_" ^ Int.toString n),
+                 string ";",
+                 newline,
+                 case eo of
+                     NONE => box []
+                   | SOME e => box [string "tmp->data.",
+                                    string x,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_exp env e,
+                                    string ";",
+                                    newline],
+                 string "tmp;",
+                 newline,
+                 string "})"]          
+        end
 
       | EFfi (m, x) => box [string "lw_", string m, string "_", string x]
       | EFfiApp (m, x, es) => box [string "lw_",
@@ -121,7 +166,7 @@
                                  space,
                                  string ("__lws_" ^ Int.toString i),
                                  space,
-                                 string "__lw_tmp",
+                                 string "tmp",
                                  space,
                                  string "=",
                                  space,
@@ -130,7 +175,7 @@
                                             p_exp env e) xes,
                                  string "};",
                                  space,
-                                 string "__lw_tmp;",
+                                 string "tmp;",
                                  space,
                                  string "})" ]
       | EField (e, x) =>
@@ -138,6 +183,8 @@
              string ".",
              string x]
 
+      | ECase _ => raise Fail "CjrPrint ECase"
+
       | EWrite e => box [string "(lw_write(ctx, ",
                          p_exp env e,
                          string "), lw_unit_v)"]
@@ -430,7 +477,7 @@
                          string "__lws_",
                          string (Int.toString i),
                          space,
-                         string "__lw_tmp",
+                         string "tmp",
                          space,
                          string "=",
                          space,
@@ -440,7 +487,7 @@
                          space,
                          string "};",
                          newline,
-                         string "__lw_tmp;",
+                         string "tmp;",
                          newline,
                          string "})"]
                 end
@@ -467,13 +514,13 @@
                                  space,
                                  string ("__lwd_" ^ x ^ "_" ^ Int.toString i),
                                  space,
-                                 string "*__lw_tmp = lw_malloc(ctx, sizeof(struct __lwd_",
+                                 string "*tmp = lw_malloc(ctx, sizeof(struct __lwd_",
                                  string x,
                                  string "_",
                                  string (Int.toString i),
                                  string "));",
                                  newline,
-                                 string "__lw_tmp->tag",
+                                 string "tmp->tag",
                                  space,
                                  string "=",
                                  space,
@@ -491,7 +538,7 @@
                                  newline,
                                  case to of
                                      NONE => box []
-                                   | SOME t => box [string "__lw_tmp->data.",
+                                   | SOME t => box [string "tmp->data.",
                                                     string x',
                                                     space,
                                                     string "=",
@@ -499,7 +546,7 @@
                                                     unurlify t,
                                                     string ";",
                                                     newline],
-                                 string "__lw_tmp;",
+                                 string "tmp;",
                                  newline,
                                  string "})",
                                  space,