diff options
| -rw-r--r-- | src/cjr_print.sml | 2 | ||||
| -rw-r--r-- | src/core_print.sml | 2 | ||||
| -rw-r--r-- | src/core_untangle.sml | 5 | ||||
| -rw-r--r-- | src/core_util.sml | 30 | ||||
| -rw-r--r-- | src/especialize.sml | 5 | ||||
| -rw-r--r-- | src/monoize.sml | 10 |
6 files changed, 35 insertions, 19 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 4828996c..2ac99827 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2829,7 +2829,7 @@ fun p_file env (ds, ps) = 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 diff --git a/src/core_print.sml b/src/core_print.sml index e9d8951e..8dcb3228 100644 --- a/src/core_print.sml +++ b/src/core_print.sml @@ -576,7 +576,7 @@ fun p_decl env (dAll as (d, _) : decl) = 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, diff --git a/src/core_untangle.sml b/src/core_untangle.sml index 1b34fe8f..480ec7a4 100644 --- a/src/core_untangle.sml +++ b/src/core_untangle.sml @@ -44,6 +44,11 @@ fun exp thisGroup (e, s) = IS.add (s, n) else s + | EClosure (n, _) => + if IS.member (thisGroup, n) then + IS.add (s, n) + else + s | _ => s diff --git a/src/core_util.sml b/src/core_util.sml index e3ec8a1d..96a05b2d 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -940,17 +940,25 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, decl = fd, bind} = 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, diff --git a/src/especialize.sml b/src/especialize.sml index 3ea4dcbd..9504a0be 100644 --- a/src/especialize.sml +++ b/src/especialize.sml @@ -348,7 +348,8 @@ fun specialize' file = (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 @@ fun specialize file = 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";*) diff --git a/src/monoize.sml b/src/monoize.sml index e8d8a122..31b80479 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -2450,7 +2450,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = _), _), (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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val (ts, fm) = tagStart "select" in ((L'.EStrcat (ts, - (L'.EPrim (Prim.String "/>"), loc)), + (L'.EPrim (Prim.String " />"), loc)), loc), fm) end | SOME (_, src, _) => |