More with attributes and efficient serialization

13 files changed, 107 insertions, 2 deletions

diff --git a/src/c/lacweb.c b/src/c/lacweb.c
index 5054d8d5..10ccd6a0 100644
--- a/src/c/lacweb.c
+++ b/src/c/lacweb.c
@@ -1,9 +1,51 @@
 #include <stdio.h>
+#include <ctype.h>
 
 #include "types.h"
 
 lw_unit lw_unit_v = {};
 
+void lw_writec(char c) {
+  fputc(c, stdout);
+}
+
 void lw_write(const char* s) {
   fputs(s, stdout);
 }
+
+char *lw_Basis_attrifyInt(lw_Basis_int n) {
+  return "0";
+}
+
+char *lw_Basis_attrifyFloat(lw_Basis_float n) {
+  return "0.0";
+}
+
+char *lw_Basis_attrifyString(lw_Basis_string s) {
+  return "";
+}
+
+char *lw_Basis_attrifyInt_w(lw_Basis_int n) {
+  printf("%d", n);
+}
+
+char *lw_Basis_attrifyFloat_w(lw_Basis_float n) {
+  printf("%g", n);
+}
+
+char *lw_Basis_attrifyString_w(lw_Basis_string s) {
+  for (; *s; s++) {
+    char c = *s;
+
+    if (c == '"')
+      lw_write("&quot;");
+    else if (isprint(c))
+      lw_writec(c);
+    else {
+      lw_write("&#");
+      lw_Basis_attrifyInt_w(c);
+      lw_writec(';');
+    }
+  }
+  lw_write(s);
+}
diff --git a/src/cjr.sml b/src/cjr.sml
index f357c351..d22b38f4 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -54,6 +54,7 @@ datatype exp' =
        | ELet of (string * typ * exp) list * exp
 
        | EWrite of exp
+       | ESeq of exp * exp
 
 withtype exp = exp' located
 
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 91e5060c..44e9f847 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -146,6 +146,13 @@ fun p_exp' par env (e, _) =
                          p_exp env e,
                          string "), lw_unit_v)"]
 
+      | ESeq (e1, e2) => box [string "(",
+                              p_exp env e1,
+                              string ",",
+                              space,
+                              p_exp env e2,
+                              string ")"]
+
 and p_exp env = p_exp' false env
 
 fun p_decl env ((d, _) : decl) =
@@ -177,7 +184,9 @@ fun p_decl env ((d, _) : decl) =
         let
             val env' = E.pushERel env x dom
         in
-            box [p_typ env ran,
+            box [string "static",
+                 space,
+                 p_typ env ran,
                  space,
                  string ("__lwc_" ^ Int.toString n),
                  string "(",
diff --git a/src/cjrize.sml b/src/cjrize.sml
index 3ae68a0a..da436720 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -167,6 +167,14 @@ fun cifyExp ((e, loc), sm) =
             ((L'.EWrite e, loc), sm)
         end
 
+      | L.ESeq (e1, e2) =>
+        let
+            val (e1, sm) = cifyExp (e1, sm)
+            val (e2, sm) = cifyExp (e2, sm)
+        in
+            ((L'.ESeq (e1, e2), loc), sm)
+        end
+
 fun cifyDecl ((d, loc), sm) =
     case d of
         L.DVal (x, n, t, e) =>
diff --git a/src/cloconv.sml b/src/cloconv.sml
index 89d64fdf..b5ea56ca 100644
--- a/src/cloconv.sml
+++ b/src/cloconv.sml
@@ -204,6 +204,14 @@ fun ccExp env ((e, loc), D) =
             ((L'.EWrite e, loc), D)
         end
 
+      | L.ESeq (e1, e2) =>
+        let
+            val (e1, D) = ccExp env (e1, D)
+            val (e2, D) = ccExp env (e2, D)
+        in
+            ((L'.ESeq (e1, e2), loc), D)
+        end
+
 fun ccDecl ((d, loc), D) =
     case d of
         L.DVal (x, n, t, e) =>
diff --git a/src/flat.sml b/src/flat.sml
index d31a2420..2b63bc24 100644
--- a/src/flat.sml
+++ b/src/flat.sml
@@ -56,6 +56,7 @@ datatype exp' =
        | EStrcat of exp * exp
 
        | EWrite of exp
+       | ESeq of exp * exp
 
 withtype exp = exp' located
 
diff --git a/src/flat_print.sml b/src/flat_print.sml
index b6c467e1..f94614b4 100644
--- a/src/flat_print.sml
+++ b/src/flat_print.sml
@@ -146,6 +146,11 @@ fun p_exp' par env (e, _) =
                          p_exp env e,
                          string ")"]
 
+      | ESeq (e1, e2) => box [p_exp env e1,
+                              string ";",
+                              space,
+                              p_exp env e2]
+
 and p_exp env = p_exp' false env
 
 fun p_decl env ((d, _) : decl) =
diff --git a/src/flat_util.sml b/src/flat_util.sml
index 0ed2a33a..7e52381d 100644
--- a/src/flat_util.sml
+++ b/src/flat_util.sml
@@ -209,6 +209,13 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                 S.map2 (mfe ctx e,
                      fn e' =>
                         (EWrite e', loc))
+
+              | ESeq (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (ESeq (e1', e2'), loc)))
     in
         mfe
     end
diff --git a/src/mono.sml b/src/mono.sml
index 1099be72..3e9e2638 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -52,6 +52,7 @@ datatype exp' =
        | EStrcat of exp * exp
 
        | EWrite of exp
+       | ESeq of exp * exp
 
 
 withtype exp = exp' located
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index c9cd5f84..30b462bf 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -81,6 +81,17 @@ fun exp e =
       | EStrcat ((EStrcat (e1, e2), loc), e3) =>
         optExp (EStrcat (e1, (EStrcat (e2, e3), loc)), loc)
 
+      | EWrite (EStrcat (e1, e2), loc) =>
+        ESeq ((optExp (EWrite e1, loc), loc),
+              (optExp (EWrite e2, loc), loc))
+
+      | EWrite (EFfiApp ("Basis", "attrifyInt", [e]), _) =>
+        EFfiApp ("Basis", "attrifyInt_w", [e])
+      | EWrite (EFfiApp ("Basis", "attrifyFloat", [e]), _) =>
+        EFfiApp ("Basis", "attrifyFloat_w", [e])
+      | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) =>
+        EFfiApp ("Basis", "attrifyString_w", [e])
+
       | _ => e
 
 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 317744ed..3797aefa 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -122,6 +122,11 @@ fun p_exp' par env (e, _) =
                          p_exp env e,
                          string ")"]
 
+      | ESeq (e1, e2) => box [p_exp env e1,
+                              string ";",
+                              space,
+                              p_exp env e2]
+
 and p_exp env = p_exp' false env
 
 fun p_decl env ((d, _) : decl) =
diff --git a/src/mono_util.sml b/src/mono_util.sml
index d095a69d..d5c047a7 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -145,6 +145,13 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                 S.map2 (mfe ctx e,
                      fn e' =>
                         (EWrite e', loc))
+
+              | ESeq (e1, e2) =>
+                S.bind2 (mfe ctx e1,
+                      fn e1' =>
+                         S.map2 (mfe ctx e2,
+                              fn e2' =>
+                                 (ESeq (e1', e2'), loc)))
     in
         mfe
     end
diff --git a/src/monoize.sml b/src/monoize.sml
index 0b868d59..1d95a303 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -81,7 +81,7 @@ val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan)
 
 fun attrifyExp (e, tAll as (t, loc)) =
     case t of
-        L'.TFfi ("Basis", "string") => e
+        L'.TFfi ("Basis", "string") => (L'.EFfiApp ("Basis", "attrifyString", [e]), loc)
       | L'.TFfi ("Basis", "int") => (L'.EFfiApp ("Basis", "attrifyInt", [e]), loc)
       | L'.TFfi ("Basis", "float") => (L'.EFfiApp ("Basis", "attrifyFloat", [e]), loc)
       | _ => (E.errorAt loc "Don't know how to encode attribute type";