summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-07-10 15:19:06 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-07-10 15:19:06 -0400
commit0c1f369955bcdfe949bb6793812ef8ead2963228 (patch)
tree00f08400cf61ad8bb9241c337719fe98f0348eb9
parent81a4a8171274586428288bd7e75ea6721ca56e27 (diff)
Stringifying attributes
-rw-r--r--lib/basis.lig4
-rw-r--r--src/mono_opt.sml20
-rw-r--r--src/monoize.sml13
-rw-r--r--tests/attrs.lac2
4 files changed, 35 insertions, 4 deletions
diff --git a/lib/basis.lig b/lib/basis.lig
index cd106950..c0f39e65 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -28,3 +28,7 @@ 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/mono_opt.sml b/src/mono_opt.sml
index 2f98a9c7..c9cd5f84 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -52,7 +52,6 @@ fun exp e =
EPrim (Prim.String (String.implode (rev chs)))
end
-
| EStrcat ((EPrim (Prim.String s1), loc), (EPrim (Prim.String s2), _)) =>
let
val s =
@@ -65,8 +64,27 @@ fun exp e =
in
EPrim (Prim.String s)
end
+
+ | EStrcat ((EPrim (Prim.String s1), loc), (EStrcat ((EPrim (Prim.String s2), _), rest), _)) =>
+ let
+ val s =
+ if size s1 > 0 andalso size s2 > 0
+ andalso Char.isSpace (String.sub (s1, size s1 - 1))
+ andalso Char.isSpace (String.sub (s2, 0)) then
+ s1 ^ String.extract (s2, 1, NONE)
+ else
+ s1 ^ s2
+ in
+ EStrcat ((EPrim (Prim.String s), loc), rest)
+ end
+
+ | EStrcat ((EStrcat (e1, e2), loc), e3) =>
+ optExp (EStrcat (e1, (EStrcat (e2, e3), loc)), loc)
+
| _ => e
+and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
+
val optimize = U.File.map {typ = typ, exp = exp, decl = decl}
end
diff --git a/src/monoize.sml b/src/monoize.sml
index ab344a16..0b868d59 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -79,6 +79,15 @@ fun monoType env (all as (c, loc)) =
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", "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";
+ Print.eprefaces' [("Type", MonoPrint.p_typ MonoEnv.empty tAll)];
+ dummyExp)
+
fun monoExp env (all as (e, loc)) =
let
fun poly () =
@@ -140,13 +149,13 @@ fun monoExp env (all as (e, loc)) =
val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc)
in
- foldl (fn ((x, e, _), s) =>
+ foldl (fn ((x, e, t), s) =>
let
val xp = " " ^ lowercaseFirst x ^ "=\""
in
(L'.EStrcat (s,
(L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
- (L'.EStrcat (e,
+ (L'.EStrcat (attrifyExp (e, t),
(L'.EPrim (Prim.String "\""), loc)),
loc)),
loc)), loc)
diff --git a/tests/attrs.lac b/tests/attrs.lac
index 0495c4eb..940971d4 100644
--- a/tests/attrs.lac
+++ b/tests/attrs.lac
@@ -1,5 +1,5 @@
val main = fn () => <html><body>
- <font face="awesome">Welcome</font>
+ <font size=42 face="awesome">Welcome</font>
</body></html>
page main