Mercurial > urweb
changeset 802:ef6de4075dc1
Fix a Core_untangle bug that missed closure variable references; XHTMLize
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 16 May 2009 12:41:33 -0400 |
| parents | 5f49a6b759cb |
| children | 152b61b2901a |
| files | src/cjr_print.sml src/core_print.sml src/core_untangle.sml src/core_util.sml src/especialize.sml src/monoize.sml |
| diffstat | 6 files changed, 35 insertions(+), 19 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjr_print.sml Thu May 14 18:13:09 2009 -0400 +++ b/src/cjr_print.sml Sat May 16 12:41:33 2009 -0400 @@ -2829,7 +2829,7 @@ newline, string "uw_write_header(ctx, \"Content-script-type: text/javascript\\r\\n\");", newline, - string "uw_write(ctx, \"<html>\");", + string "uw_write(ctx, \"<!DOCTYPE html PUBLIC \\\"-//W3C//DTD XHTML 1.0 Transitional//EN\\\" \\\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\\\">\\n<html>\");", newline, string "uw_set_script_header(ctx, \"", string (case side of
--- a/src/core_print.sml Thu May 14 18:13:09 2009 -0400 +++ b/src/core_print.sml Sat May 16 12:41:33 2009 -0400 @@ -576,7 +576,7 @@ space, string "constraints", space, - p_exp env ce] + p_exp (E.declBinds env dAll) ce] | DSequence (x, n, s) => box [string "sequence", space, p_named x n,
--- a/src/core_untangle.sml Thu May 14 18:13:09 2009 -0400 +++ b/src/core_untangle.sml Sat May 16 12:41:33 2009 -0400 @@ -44,6 +44,11 @@ IS.add (s, n) else s + | EClosure (n, _) => + if IS.member (thisGroup, n) then + IS.add (s, n) + else + s | _ => s
--- a/src/core_util.sml Thu May 14 18:13:09 2009 -0400 +++ b/src/core_util.sml Sat May 16 12:41:33 2009 -0400 @@ -940,17 +940,25 @@ end | DExport _ => S.return2 dAll | DTable (x, n, c, s, pe, pc, ce, cc) => - S.bind2 (mfc ctx c, - fn c' => - S.bind2 (mfe ctx pe, - fn pe' => - S.bind2 (mfc ctx pc, - fn pc' => - S.bind2 (mfe ctx ce, - fn ce' => - S.map2 (mfc ctx cc, - fn cc' => - (DTable (x, n, c', s, pe', pc', ce', cc'), loc)))))) + let + val loc = #2 ce + val ct = (CFfi ("Basis", "sql_table"), loc) + val ct = (CApp (ct, (CConcat (pc, cc), loc)), loc) + val ct = (CApp (ct, cc), loc) + val ctx' = bind (ctx, NamedE (x, n, ct, NONE, s)) + in + S.bind2 (mfc ctx c, + fn c' => + S.bind2 (mfe ctx' pe, + fn pe' => + S.bind2 (mfc ctx pc, + fn pc' => + S.bind2 (mfe ctx' ce, + fn ce' => + S.map2 (mfc ctx cc, + fn cc' => + (DTable (x, n, c', s, pe', pc', ce', cc'), loc)))))) + end | DSequence _ => S.return2 dAll | DView (x, n, s, e, c) => S.bind2 (mfe ctx e,
--- a/src/especialize.sml Thu May 14 18:13:09 2009 -0400 +++ b/src/especialize.sml Sat May 16 12:41:33 2009 -0400 @@ -348,7 +348,8 @@ (DValRec vis', _) => [(DValRec (vis @ vis'), ErrorMsg.dummySpan)] | _ => [(DValRec vis, ErrorMsg.dummySpan), d']) in - (*Print.prefaces "doDecl" [("d", CorePrint.p_decl E.empty d)];*) + (*Print.prefaces "doDecl" [("d", CorePrint.p_decl E.empty d), + ("d'", CorePrint.p_decl E.empty d')];*) (ds, ({maxName = #maxName st, funcs = funcs, decls = []}, changed)) @@ -378,7 +379,9 @@ if changed then let (*val file = ReduceLocal.reduce file*) + (*val () = Print.prefaces "Pre-untangle" [("file", CorePrint.p_file CoreEnv.empty file)]*) val file = CoreUntangle.untangle file + (*val () = Print.prefaces "Post-untangle" [("file", CorePrint.p_file CoreEnv.empty file)]*) val file = Shake.shake file in (*print "Again!\n";*)
--- a/src/monoize.sml Thu May 14 18:13:09 2009 -0400 +++ b/src/monoize.sml Sat May 16 12:41:33 2009 -0400 @@ -2450,7 +2450,7 @@ val (ts, fm) = tagStart "input" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\"/>")), + (L'.EPrim (Prim.String (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\" />")), loc)), loc), fm) end | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); @@ -2486,7 +2486,7 @@ _), _), (L.EPrim (Prim.String s), _)), _) => if CharVector.all Char.isSpace s then - ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String "/>"), loc)), loc), fm) + ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm) else normal () | _ => normal () @@ -2561,7 +2561,7 @@ val (ts, fm) = tagStart "input" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\"/>")), + (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\" />")), loc)), loc), fm) end | SOME (_, src, _) => @@ -2632,7 +2632,7 @@ val (ts, fm) = tagStart "input" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String "/>"), loc)), + (L'.EPrim (Prim.String " />"), loc)), loc), fm) end | SOME (_, src, _) => @@ -2655,7 +2655,7 @@ val (ts, fm) = tagStart "select" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String "/>"), loc)), + (L'.EPrim (Prim.String " />"), loc)), loc), fm) end | SOME (_, src, _) =>