# HG changeset patch # User Adam Chlipala # Date 1215717546 14400 # Node ID da760c34f5ede72fbb01eae4ce0e0f1d21c344a8 # Parent b1e5398a7f30066d4d3b38428a1682211704ceb7 Stringifying attributes diff -r b1e5398a7f30 -r da760c34f5ed lib/basis.lig --- a/lib/basis.lig Thu Jul 10 15:04:32 2008 -0400 +++ b/lib/basis.lig Thu Jul 10 15:19:06 2008 -0400 @@ -28,3 +28,7 @@ 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 -r b1e5398a7f30 -r da760c34f5ed src/mono_opt.sml --- a/src/mono_opt.sml Thu Jul 10 15:04:32 2008 -0400 +++ b/src/mono_opt.sml Thu Jul 10 15:19:06 2008 -0400 @@ -52,7 +52,6 @@ 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 @@ 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 -r b1e5398a7f30 -r da760c34f5ed src/monoize.sml --- a/src/monoize.sml Thu Jul 10 15:04:32 2008 -0400 +++ b/src/monoize.sml Thu Jul 10 15:19:06 2008 -0400 @@ -79,6 +79,15 @@ 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 @@ 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 -r b1e5398a7f30 -r da760c34f5ed tests/attrs.lac --- a/tests/attrs.lac Thu Jul 10 15:04:32 2008 -0400 +++ b/tests/attrs.lac Thu Jul 10 15:19:06 2008 -0400 @@ -1,5 +1,5 @@ val main = fn () => - Welcome + Welcome page main