aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--include/lacweb.h4
-rw-r--r--lib/basis.lig4
-rw-r--r--src/c/lacweb.c42
-rw-r--r--src/cjr.sml1
-rw-r--r--src/cjr_print.sml11
-rw-r--r--src/cjrize.sml8
-rw-r--r--src/cloconv.sml8
-rw-r--r--src/flat.sml1
-rw-r--r--src/flat_print.sml5
-rw-r--r--src/flat_util.sml7
-rw-r--r--src/mono.sml1
-rw-r--r--src/mono_opt.sml11
-rw-r--r--src/mono_print.sml5
-rw-r--r--src/mono_util.sml7
-rw-r--r--src/monoize.sml2
-rw-r--r--tests/attrs_escape.lac6
16 files changed, 117 insertions, 6 deletions
diff --git a/include/lacweb.h b/include/lacweb.h
index 14431df1..983f979a 100644
--- a/include/lacweb.h
+++ b/include/lacweb.h
@@ -3,3 +3,7 @@
extern lw_unit lw_unit_v;
void lw_write(const char*);
+
+char *lw_Basis_attrifyInt(lw_Basis_int);
+char *lw_Basis_attrifyFloat(lw_Basis_float);
+char *lw_Basis_attrifyString(lw_Basis_string);
diff --git a/lib/basis.lig b/lib/basis.lig
index c0f39e65..cd106950 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -28,7 +28,3 @@ val p : tag [] [Body] [Body]
val b : tag [] [Body] [Body]
val i : tag [] [Body] [Body]
val font : tag [Size = int, Face = string] [Body] [Body]
-
-
-val attrifyInt : int -> string
-val attrifyFloat : float -> string
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";
diff --git a/tests/attrs_escape.lac b/tests/attrs_escape.lac
new file mode 100644
index 00000000..2194ce09
--- /dev/null
+++ b/tests/attrs_escape.lac
@@ -0,0 +1,6 @@
+val main = fn () => <html><body>
+ <font face="\"Well hey\"
+Wow">Welcome</font>
+</body></html>
+
+page main
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-25 22:36:36 +0000