Mercurial > urweb
changeset 1663:0577be31a435
First part of changes to avoid depending on C function call argument order of evaluation (omitting normal Ur function calls, so far)
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sat, 07 Jan 2012 15:56:22 -0500 |
| parents | edf86cef0dba |
| children | a12186d99e4f |
| files | include/urweb.h src/checknest.sml src/cjr.sml src/cjr_print.sml src/cjrize.sml src/core.sml src/core_print.sml src/core_util.sml src/corify.sml src/css.sml src/especialize.sml src/iflow.sml src/jscomp.sml src/mono.sml src/mono_opt.sml src/mono_print.sml src/mono_reduce.sml src/mono_util.sml src/monoize.sml src/prepare.sml src/reduce.sml src/reduce_local.sml src/scriptcheck.sml src/tag.sml |
| diffstat | 24 files changed, 369 insertions(+), 265 deletions(-) [+] |
line wrap: on
line diff
--- a/include/urweb.h Sat Jan 07 11:01:21 2012 -0500 +++ b/include/urweb.h Sat Jan 07 15:56:22 2012 -0500 @@ -30,7 +30,7 @@ void uw_reset(uw_context); void uw_reset_keep_request(uw_context); void uw_reset_keep_error_message(uw_context); -const char *uw_get_url_prefix(uw_context); +char *uw_get_url_prefix(uw_context); failure_kind uw_begin_init(uw_context); void uw_set_on_success(char *); @@ -75,9 +75,9 @@ uw_unit uw_Basis_set_client_source(uw_context, uw_Basis_source, uw_Basis_string); void uw_set_script_header(uw_context, const char*); -const char *uw_Basis_get_settings(uw_context, uw_unit); -const char *uw_Basis_get_script(uw_context, uw_unit); -const char *uw_get_real_script(uw_context); +char *uw_Basis_get_settings(uw_context, uw_unit); +char *uw_Basis_get_script(uw_context, uw_unit); +char *uw_get_real_script(uw_context); uw_Basis_string uw_Basis_maybe_onload(uw_context, uw_Basis_string); uw_Basis_string uw_Basis_maybe_onunload(uw_context, uw_Basis_string);
--- a/src/checknest.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/checknest.sml Sat Jan 07 15:56:22 2012 -0500 @@ -44,7 +44,7 @@ | ENone _ => IS.empty | ESome (_, e) => eu e | EFfi _ => IS.empty - | EFfiApp (_, _, es) => foldl IS.union IS.empty (map eu es) + | EFfiApp (_, _, es) => foldl IS.union IS.empty (map (eu o #1) es) | EApp (e, es) => foldl IS.union (eu e) (map eu es) | EUnop (_, e) => eu e @@ -106,7 +106,7 @@ | ENone _ => e | ESome (t, e) => (ESome (t, ae e), loc) | EFfi _ => e - | EFfiApp (m, f, es) => (EFfiApp (m, f, map ae es), loc) + | EFfiApp (m, f, es) => (EFfiApp (m, f, map (fn (e, t) => (ae e, t)) es), loc) | EApp (e, es) => (EApp (ae e, map ae es), loc) | EUnop (uo, e) => (EUnop (uo, ae e), loc)
--- a/src/cjr.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/cjr.sml Sat Jan 07 15:56:22 2012 -0500 @@ -66,7 +66,7 @@ | ENone of typ | ESome of typ * exp | EFfi of string * string - | EFfiApp of string * string * exp list + | EFfiApp of string * string * (exp * typ) list | EApp of exp * exp list | EUnop of string * exp
--- a/src/cjr_print.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/cjr_print.sml Sat Jan 07 15:56:22 2012 -0500 @@ -490,23 +490,23 @@ fun getPargs (e, _) = case e of EPrim (Prim.String _) => [] - | EFfiApp ("Basis", "strcat", [e1, e2]) => getPargs e1 @ getPargs e2 + | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => getPargs e1 @ getPargs e2 - | EFfiApp ("Basis", "sqlifyInt", [e]) => [(e, Int)] - | EFfiApp ("Basis", "sqlifyFloat", [e]) => [(e, Float)] - | EFfiApp ("Basis", "sqlifyString", [e]) => [(e, String)] - | EFfiApp ("Basis", "sqlifyBool", [e]) => [(e, Bool)] - | EFfiApp ("Basis", "sqlifyTime", [e]) => [(e, Time)] - | EFfiApp ("Basis", "sqlifyBlob", [e]) => [(e, Blob)] - | EFfiApp ("Basis", "sqlifyChannel", [e]) => [(e, Channel)] - | EFfiApp ("Basis", "sqlifyClient", [e]) => [(e, Client)] + | EFfiApp ("Basis", "sqlifyInt", [(e, _)]) => [(e, Int)] + | EFfiApp ("Basis", "sqlifyFloat", [(e, _)]) => [(e, Float)] + | EFfiApp ("Basis", "sqlifyString", [(e, _)]) => [(e, String)] + | EFfiApp ("Basis", "sqlifyBool", [(e, _)]) => [(e, Bool)] + | EFfiApp ("Basis", "sqlifyTime", [(e, _)]) => [(e, Time)] + | EFfiApp ("Basis", "sqlifyBlob", [(e, _)]) => [(e, Blob)] + | EFfiApp ("Basis", "sqlifyChannel", [(e, _)]) => [(e, Channel)] + | EFfiApp ("Basis", "sqlifyClient", [(e, _)]) => [(e, Client)] | ECase (e, [((PNone _, _), (EPrim (Prim.String "NULL"), _)), ((PSome (_, (PVar _, _)), _), - (EFfiApp (m, x, [(ERel 0, _)]), _))], - _) => map (fn (x, y) => (x, Nullable y)) (getPargs (EFfiApp (m, x, [e]), #2 e)) + (EFfiApp (m, x, [((ERel 0, _), _)]), _))], + {disc = t, ...}) => map (fn (x, y) => (x, Nullable y)) (getPargs (EFfiApp (m, x, [(e, t)]), #2 e)) | ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _), @@ -1442,7 +1442,63 @@ val self = ref (NONE : int option) -fun p_exp' par tail env (e, loc) = +(* The crucial thing to do here is assign arguments to local variables, to enforce order of evaluation. + * Otherwise, we are at the mercy of C's undefined order of function argument evaluation. *) +fun pFuncall env (m, x, es, extra) = + case es of + [] => box [string "uw_", + p_ident m, + string "_", + p_ident x, + string "(ctx", + case extra of + NONE => box [] + | SOME extra => box [string ",", + space, + string extra], + string ")"] + | [(e, _)] => box [string "uw_", + p_ident m, + string "_", + p_ident x, + string "(ctx,", + space, + p_exp' false false env e, + case extra of + NONE => box [] + | SOME extra => box [string ",", + space, + string extra], + string ")"] + | _ => box [string "({", + newline, + p_list_sepi (box []) (fn i => fn (e, t) => + box [p_typ env t, + space, + string "arg", + string (Int.toString i), + space, + string "=", + space, + p_exp' false false env e, + string ";", + newline]) es, + string "uw_", + p_ident m, + string "_", + p_ident x, + string "(ctx, ", + p_list_sepi (box [string ",", space]) (fn i => fn _ => box [string "arg", string (Int.toString i)]) es, + case extra of + NONE => box [] + | SOME extra => box [string ",", + space, + string extra], + string ");", + newline, + string "})"] + +and p_exp' par tail env (e, loc) = case e of EPrim p => Prim.p_t_GCC p | ERel n => p_rel env n @@ -1572,15 +1628,29 @@ | EReturnBlob {blob, mimeType, t} => box [string "({", newline, + string "uw_Basis_blob", + space, + string "blob", + space, + string "=", + space, + p_exp' false false env blob, + string ";", + newline, + string "uw_Basis_string", + space, + string "mimeType", + space, + string "=", + space, + p_exp' false false env mimeType, + string ";", + newline, p_typ env t, space, string "tmp;", newline, - string "uw_return_blob(ctx, ", - p_exp' false false env blob, - string ", ", - p_exp' false false env mimeType, - string ");", + string "uw_return_blob(ctx, blob, mimeType);", newline, string "tmp;", newline, @@ -1604,37 +1674,23 @@ | EApp ((EReturnBlob {blob, mimeType, t = (TFun (_, ran), _)}, loc), _) => p_exp' false false env (EReturnBlob {blob = blob, mimeType = mimeType, t = ran}, loc) - | EFfiApp ("Basis", "strcat", [e1, e2]) => + | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => let fun flatten e = case #1 e of - EFfiApp ("Basis", "strcat", [e1, e2]) => flatten e1 @ flatten e2 + EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => flatten e1 @ flatten e2 | _ => [e] + + val es = flatten e1 @ flatten e2 + val t = (TFfi ("Basis", "string"), loc) + val es = map (fn e => (e, t)) es in - case flatten e1 @ flatten e2 of - [e1, e2] => box [string "uw_Basis_strcat(ctx, ", - p_exp' false false env e1, - string ",", - p_exp' false false env e2, - string ")"] - | es => box [string "uw_Basis_mstrcat(ctx, ", - p_list (p_exp' false false env) es, - string ", NULL)"] + case es of + [_, _] => pFuncall env ("Basis", "strcat", es, NONE) + | _ => pFuncall env ("Basis", "mstrcat", es, SOME "NULL") end - | EFfiApp (m, x, []) => box [string "uw_", - p_ident m, - string "_", - p_ident x, - string "(ctx)"] - - | EFfiApp (m, x, es) => box [string "uw_", - p_ident m, - string "_", - p_ident x, - string "(ctx, ", - p_list (p_exp' false false env) es, - string ")"] + | EFfiApp (m, x, es) => pFuncall env (m, x, es, NONE) | EApp (f, args) => let fun default () = parenIf par (box [p_exp' true false env f, @@ -3036,7 +3092,7 @@ case e of ECon (_, _, SOME e) => expDb e | ESome (_, e) => expDb e - | EFfiApp (_, _, es) => List.exists expDb es + | EFfiApp (_, _, es) => List.exists (expDb o #1) es | EApp (e, es) => expDb e orelse List.exists expDb es | EUnop (_, e) => expDb e | EBinop (_, e1, e2) => expDb e1 orelse expDb e2
--- a/src/cjrize.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/cjrize.sml Sat Jan 07 15:56:22 2012 -0500 @@ -277,7 +277,13 @@ | L.EFfi mx => ((L'.EFfi mx, loc), sm) | L.EFfiApp (m, x, es) => let - val (es, sm) = ListUtil.foldlMap cifyExp sm es + val (es, sm) = ListUtil.foldlMap (fn ((e, t), sm) => + let + val (t, sm) = cifyTyp (t, sm) + val (e, sm) = cifyExp (e, sm) + in + ((e, t), sm) + end) sm es in ((L'.EFfiApp (m, x, es), loc), sm) end @@ -384,8 +390,9 @@ let val (e1, sm) = cifyExp (e1, sm) val (e2, sm) = cifyExp (e2, sm) + val s = (L'.TFfi ("Basis", "string"), loc) in - ((L'.EFfiApp ("Basis", "strcat", [e1, e2]), loc), sm) + ((L'.EFfiApp ("Basis", "strcat", [(e1, s), (e2, s)]), loc), sm) end | L.EWrite e => @@ -673,7 +680,7 @@ val tk = case #1 e1 of L.EFfi ("Basis", "initialize") => L'.Initialize | L.EFfi ("Basis", "clientLeaves") => L'.ClientLeaves - | L.EFfiApp ("Basis", "periodic", [(L.EPrim (Prim.Int n), _)]) => L'.Periodic n + | L.EFfiApp ("Basis", "periodic", [((L.EPrim (Prim.Int n), _), _)]) => L'.Periodic n | _ => (ErrorMsg.errorAt loc "Task kind not fully determined"; L'.Initialize) val (e, sm) = cifyExp (e, sm)
--- a/src/core.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/core.sml Sat Jan 07 15:56:22 2012 -0500 @@ -92,7 +92,7 @@ | ENamed of int | ECon of datatype_kind * patCon * con list * exp option | EFfi of string * string - | EFfiApp of string * string * exp list + | EFfiApp of string * string * (exp * con) list | EApp of exp * exp | EAbs of string * con * con * exp | ECApp of exp * con
--- a/src/core_print.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/core_print.sml Sat Jan 07 15:56:22 2012 -0500 @@ -276,7 +276,7 @@ string ".", string x, string "(", - p_list (p_exp env) es, + p_list (p_exp env o #1) es, string "))"] | EApp (e1, e2) => parenIf par (box [p_exp' true env e1, space,
--- a/src/core_util.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/core_util.sml Sat Jan 07 15:56:22 2012 -0500 @@ -468,7 +468,7 @@ | (EFfiApp (f1, x1, es1), EFfiApp (f2, x2, es2)) => join (String.compare (f1, f2), fn () => join (String.compare (x1, x2), - fn () => joinL compare (es1, es2))) + fn () => joinL (fn ((e1, _), (e2, _)) => compare (e1, e2))(es1, es2))) | (EFfiApp _, _) => LESS | (_, EFfiApp _) => GREATER @@ -586,6 +586,12 @@ fun mfe ctx e acc = S.bindP (mfe' ctx e acc, fe ctx) + and mfet ctx (e, t) = + S.bind2 (mfe ctx e, + fn e' => + S.map2 (mfc ctx t, + fn t' => (e', t'))) + and mfe' ctx (eAll as (e, loc)) = case e of EPrim _ => S.return2 eAll @@ -603,7 +609,7 @@ (ECon (dk, n, cs', SOME e'), loc))) | EFfi _ => S.return2 eAll | EFfiApp (m, x, es) => - S.map2 (ListUtil.mapfold (mfe ctx) es, + S.map2 (ListUtil.mapfold (mfet ctx) es, fn es' => (EFfiApp (m, x, es'), loc)) | EApp (e1, e2) =>
--- a/src/corify.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/corify.sml Sat Jan 07 15:56:22 2012 -0500 @@ -562,8 +562,8 @@ fun makeApp n = let - val (actuals, _) = foldr (fn (_, (actuals, n)) => - ((L'.ERel n, loc) :: actuals, + val (actuals, _) = foldr (fn (t, (actuals, n)) => + (((L'.ERel n, loc), t) :: actuals, n + 1)) ([], n) args in (L'.EFfiApp (m, x, actuals), loc)
--- a/src/css.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/css.sml Sat Jan 07 15:56:22 2012 -0500 @@ -138,7 +138,7 @@ | ECon (_, _, _, NONE) => ([], classes) | ECon (_, _, _, SOME e) => exp (e, classes) | EFfi _ => ([], classes) - | EFfiApp (_, _, es) => expList (es, classes) + | EFfiApp (_, _, es) => expList (map #1 es, classes) | EApp ( (EApp (
--- a/src/especialize.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/especialize.sml Sat Jan 07 15:56:22 2012 -0500 @@ -180,7 +180,12 @@ | EFfi _ => (e, st) | EFfiApp (m, x, es) => let - val (es, st) = ListUtil.foldlMap (fn (e, st) => exp (env, e, st)) st es + val (es, st) = ListUtil.foldlMap (fn ((e, t), st) => + let + val (e, st) = exp (env, e, st) + in + ((e, t), st) + end) st es in ((EFfiApp (m, x, es), loc), st) end
--- a/src/iflow.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/iflow.sml Sat Jan 07 15:56:22 2012 -0500 @@ -1044,7 +1044,7 @@ fun sqlify chs = case chs of - Exp (EFfiApp ("Basis", f, [e]), _) :: chs => + Exp (EFfiApp ("Basis", f, [(e, _)]), _) :: chs => if String.isPrefix "sqlify" f then SOME (e, chs) else @@ -1859,7 +1859,7 @@ [] => (if s = "set_cookie" then case es of - [_, cname, _, _, _] => + [_, (cname, _), _, _, _] => (case #1 cname of EPrim (Prim.String cname) => St.havocCookie cname @@ -1868,7 +1868,7 @@ else (); k (Recd [])) - | e :: es => + | (e, _) :: es => evalExp env e (fn e => (St.send (e, loc); doArgs es)) in doArgs es @@ -1880,7 +1880,7 @@ fun doArgs (es, acc) = case es of [] => k (Func (Other (m ^ "." ^ s), rev acc)) - | e :: es => + | (e, _) :: es => evalExp env e (fn e => doArgs (es, e :: acc)) in doArgs (es, []) @@ -1904,7 +1904,7 @@ k e end | EFfiApp x => doFfi x - | EApp ((EFfi (m, s), _), e) => doFfi (m, s, [e]) + | EApp ((EFfi (m, s), _), e) => doFfi (m, s, [(e, (TRecord [], loc))]) | EApp (e1 as (EError _, _), _) => evalExp env e1 k @@ -2051,7 +2051,7 @@ | Update (tab, _, _) => (cs, SS.add (ts, tab))) | EFfiApp ("Basis", "set_cookie", - [_, (EPrim (Prim.String cname), _), + [_, ((EPrim (Prim.String cname), _), _), _, _, _]) => (SS.add (cs, cname), ts) | _ => st} @@ -2189,7 +2189,7 @@ | ENextval _ => default () | ESetval _ => default () - | EUnurlify ((EFfiApp ("Basis", "get_cookie", [(EPrim (Prim.String cname), _)]), _), _, _) => + | EUnurlify ((EFfiApp ("Basis", "get_cookie", [((EPrim (Prim.String cname), _), _)]), _), _, _) => let val e = Var (St.nextVar ()) val e' = Func (Other ("cookie/" ^ cname), []) @@ -2301,10 +2301,10 @@ | EFfi _ => e | EFfiApp (m, f, es) => (case (m, f, es) of - ("Basis", "set_cookie", [_, (EPrim (Prim.String cname), _), _, _, _]) => + ("Basis", "set_cookie", [_, ((EPrim (Prim.String cname), _), _), _, _, _]) => cookies := SS.add (!cookies, cname) | _ => (); - (EFfiApp (m, f, map (doExp env) es), loc)) + (EFfiApp (m, f, map (fn (e, t) => (doExp env e, t)) es), loc)) | EApp (e1, e2) => let
--- a/src/jscomp.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/jscomp.sml Sat Jan 07 15:56:22 2012 -0500 @@ -91,7 +91,7 @@ fun quoteExp loc (t : typ) (e, st) = case #1 t of - TSource => ((EFfiApp ("Basis", "htmlifySource", [e]), loc), st) + TSource => ((EFfiApp ("Basis", "htmlifySource", [(e, t)]), loc), st) | TRecord [] => (str loc "null", st) | TRecord [(x, t)] => @@ -120,12 +120,12 @@ @ [str loc "}"]), st) end - | TFfi ("Basis", "string") => ((EFfiApp ("Basis", "jsifyString", [e]), loc), st) - | TFfi ("Basis", "char") => ((EFfiApp ("Basis", "jsifyChar", [e]), loc), st) - | TFfi ("Basis", "int") => ((EFfiApp ("Basis", "htmlifyInt", [e]), loc), st) - | TFfi ("Basis", "float") => ((EFfiApp ("Basis", "htmlifyFloat", [e]), loc), st) - | TFfi ("Basis", "channel") => ((EFfiApp ("Basis", "jsifyChannel", [e]), loc), st) - | TFfi ("Basis", "time") => ((EFfiApp ("Basis", "jsifyTime", [e]), loc), st) + | TFfi ("Basis", "string") => ((EFfiApp ("Basis", "jsifyString", [(e, t)]), loc), st) + | TFfi ("Basis", "char") => ((EFfiApp ("Basis", "jsifyChar", [(e, t)]), loc), st) + | TFfi ("Basis", "int") => ((EFfiApp ("Basis", "htmlifyInt", [(e, t)]), loc), st) + | TFfi ("Basis", "float") => ((EFfiApp ("Basis", "htmlifyFloat", [(e, t)]), loc), st) + | TFfi ("Basis", "channel") => ((EFfiApp ("Basis", "jsifyChannel", [(e, t)]), loc), st) + | TFfi ("Basis", "time") => ((EFfiApp ("Basis", "jsifyTime", [(e, t)]), loc), st) | TFfi ("Basis", "bool") => ((ECase (e, [((PCon (Enum, PConFfi {mod = "Basis", @@ -511,7 +511,7 @@ case e of EPrim (Prim.String s) => jsifyStringMulti (level, s) | EStrcat (e1, e2) => deStrcat level e1 ^ deStrcat level e2 - | EFfiApp ("Basis", "jsifyString", [e]) => "\"" ^ deStrcat (level + 1) e ^ "\"" + | EFfiApp ("Basis", "jsifyString", [(e, _)]) => "\"" ^ deStrcat (level + 1) e ^ "\"" | _ => (Print.prefaces "deStrcat" [("e", MonoPrint.p_exp MonoEnv.empty all)]; raise Fail "Jscomp: deStrcat") @@ -645,7 +645,7 @@ "ERROR") | SOME s => s - val (e, st) = foldr (fn (e, (acc, st)) => + val (e, st) = foldr (fn ((e, _), (acc, st)) => let val (e, st) = jsE inner (e, st) in @@ -1024,7 +1024,12 @@ | EFfi _ => (e, st) | EFfiApp (m, x, es) => let - val (es, st) = ListUtil.foldlMap (exp outer) st es + val (es, st) = ListUtil.foldlMap (fn ((e, t), st) => + let + val (e, st) = exp outer (e, st) + in + ((e, t), st) + end) st es in ((EFfiApp (m, x, es), loc), st) end
--- a/src/mono.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/mono.sml Sat Jan 07 15:56:22 2012 -0500 @@ -78,7 +78,7 @@ | ENone of typ | ESome of typ * exp | EFfi of string * string - | EFfiApp of string * string * exp list + | EFfiApp of string * string * (exp * typ) list | EApp of exp * exp | EAbs of string * typ * typ * exp
--- a/src/mono_opt.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/mono_opt.sml Sat Jan 07 15:56:22 2012 -0500 @@ -138,7 +138,7 @@ EPrim (Prim.String (String.implode (rev chs))) end - | EFfiApp ("Basis", "strcat", [e1, e2]) => exp (EStrcat (e1, e2)) + | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => exp (EStrcat (e1, e2)) | EStrcat ((EPrim (Prim.String s1), loc), (EPrim (Prim.String s2), _)) => let @@ -182,153 +182,153 @@ ESeq ((EWrite (EPrim (Prim.String (s1 ^ s2)), loc), loc), e) - | EFfiApp ("Basis", "htmlifySpecialChar", [(EPrim (Prim.Char ch), _)]) => + | EFfiApp ("Basis", "htmlifySpecialChar", [((EPrim (Prim.Char ch), _), _)]) => EPrim (Prim.String (htmlifySpecialChar ch)) | EWrite (EFfiApp ("Basis", "htmlifySpecialChar", [e]), _) => EFfiApp ("Basis", "htmlifySpecialChar_w", [e]) - | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "intToString", [(EPrim (Prim.Int n), _)]), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "intToString", [((EPrim (Prim.Int n), _), _)]), _), _)]) => EPrim (Prim.String (htmlifyInt n)) - | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "intToString", es), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "intToString", es), _), _)]) => EFfiApp ("Basis", "htmlifyInt", es) - | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "intToString"), _), - (EPrim (Prim.Int n), _)), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "intToString"), _), + (EPrim (Prim.Int n), _)), _), _)]) => EPrim (Prim.String (htmlifyInt n)) - | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "intToString"), _), - e), _)]) => - EFfiApp ("Basis", "htmlifyInt", [e]) + | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "intToString"), _), + e), loc), _)]) => + EFfiApp ("Basis", "htmlifyInt", [(e, (TFfi ("Basis", "int"), loc))]) | EWrite (EFfiApp ("Basis", "htmlifyInt", [e]), _) => EFfiApp ("Basis", "htmlifyInt_w", [e]) - | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "floatToString", [(EPrim (Prim.Float n), _)]), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "floatToString", [((EPrim (Prim.Float n), _), _)]), _), _)]) => EPrim (Prim.String (htmlifyFloat n)) - | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "floatToString", es), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "floatToString", es), _), _)]) => EFfiApp ("Basis", "htmlifyFloat", es) - | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "floatToString"), _), - (EPrim (Prim.Float n), _)), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "floatToString"), _), + (EPrim (Prim.Float n), _)), _), _)]) => EPrim (Prim.String (htmlifyFloat n)) - | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "floatToString"), _), - e), _)]) => - EFfiApp ("Basis", "htmlifyFloat", [e]) + | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "floatToString"), _), + e), loc), _)]) => + EFfiApp ("Basis", "htmlifyFloat", [(e, (TFfi ("Basis", "float"), loc))]) | EWrite (EFfiApp ("Basis", "htmlifyFloat", [e]), _) => EFfiApp ("Basis", "htmlifyFloat_w", [e]) - | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "boolToString", - [(ECon (Enum, PConFfi {con = "True", ...}, NONE), _)]), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString", + [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]), _), _)]) => EPrim (Prim.String "True") - | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "boolToString", - [(ECon (Enum, PConFfi {con = "False", ...}, NONE), _)]), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString", + [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]), _), _)]) => EPrim (Prim.String "False") - | EFfiApp ("Basis", "htmlifyString", [(EFfiApp ("Basis", "boolToString", es), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EFfiApp ("Basis", "boolToString", es), _), _)]) => EFfiApp ("Basis", "htmlifyBool", es) - | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "boolToString"), _), - (ECon (Enum, PConFfi {con = "True", ...}, NONE), _)), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _), + (ECon (Enum, PConFfi {con = "True", ...}, NONE), _)), _), _)]) => EPrim (Prim.String "True") - | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "boolToString"), _), - (ECon (Enum, PConFfi {con = "False", ...}, NONE), _)), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _), + (ECon (Enum, PConFfi {con = "False", ...}, NONE), _)), _), _)]) => EPrim (Prim.String "False") - | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "boolToString"), _), - e), _)]) => - EFfiApp ("Basis", "htmlifyBool", [e]) + | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "boolToString"), _), + e), loc), _)]) => + EFfiApp ("Basis", "htmlifyBool", [(e, (TFfi ("Basis", "bool"), loc))]) | EWrite (EFfiApp ("Basis", "htmlifyBool", [e]), _) => EFfiApp ("Basis", "htmlifyBool_w", [e]) - | EFfiApp ("Basis", "htmlifyString", [(EApp ((EFfi ("Basis", "timeToString"), _), e), _)]) => - EFfiApp ("Basis", "htmlifyTime", [e]) - | EFfiApp ("Basis", "htmlifyString_w", [(EApp ((EFfi ("Basis", "timeToString"), _), e), _)]) => - EFfiApp ("Basis", "htmlifyTime_w", [e]) + | EFfiApp ("Basis", "htmlifyString", [((EApp ((EFfi ("Basis", "timeToString"), _), e), loc), _)]) => + EFfiApp ("Basis", "htmlifyTime", [(e, (TFfi ("Basis", "time"), loc))]) + | EFfiApp ("Basis", "htmlifyString_w", [((EApp ((EFfi ("Basis", "timeToString"), loc), e), _), _)]) => + EFfiApp ("Basis", "htmlifyTime_w", [(e, (TFfi ("Basis", "time"), loc))]) | EWrite (EFfiApp ("Basis", "htmlifyTime", [e]), _) => EFfiApp ("Basis", "htmlifyTime_w", [e]) - | EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]) => + | EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String s), _), _)]) => EPrim (Prim.String (htmlifyString s)) - | EWrite (EFfiApp ("Basis", "htmlifyString", [(EPrim (Prim.String s), _)]), loc) => + | EWrite (EFfiApp ("Basis", "htmlifyString", [((EPrim (Prim.String s), _), _)]), loc) => EWrite (EPrim (Prim.String (htmlifyString s)), loc) | EWrite (EFfiApp ("Basis", "htmlifyString", [e]), _) => EFfiApp ("Basis", "htmlifyString_w", [e]) - | EFfiApp ("Basis", "htmlifyString_w", [(EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "htmlifyString_w", [((EPrim (Prim.String s), loc), _)]) => EWrite (EPrim (Prim.String (htmlifyString s)), loc) | EWrite (EFfiApp ("Basis", "htmlifySource", [e]), _) => EFfiApp ("Basis", "htmlifySource_w", [e]) - | EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]) => + | EFfiApp ("Basis", "attrifyInt", [((EPrim (Prim.Int n), _), _)]) => EPrim (Prim.String (attrifyInt n)) - | EWrite (EFfiApp ("Basis", "attrifyInt", [(EPrim (Prim.Int n), _)]), loc) => + | EWrite (EFfiApp ("Basis", "attrifyInt", [((EPrim (Prim.Int n), _), _)]), loc) => EWrite (EPrim (Prim.String (attrifyInt n)), loc) | EWrite (EFfiApp ("Basis", "attrifyInt", [e]), _) => EFfiApp ("Basis", "attrifyInt_w", [e]) - | EFfiApp ("Basis", "attrifyFloat", [(EPrim (Prim.Float n), _)]) => + | EFfiApp ("Basis", "attrifyFloat", [((EPrim (Prim.Float n), _), _)]) => EPrim (Prim.String (attrifyFloat n)) - | EWrite (EFfiApp ("Basis", "attrifyFloat", [(EPrim (Prim.Float n), _)]), loc) => + | EWrite (EFfiApp ("Basis", "attrifyFloat", [((EPrim (Prim.Float n), _), _)]), loc) => EWrite (EPrim (Prim.String (attrifyFloat n)), loc) | EWrite (EFfiApp ("Basis", "attrifyFloat", [e]), _) => EFfiApp ("Basis", "attrifyFloat_w", [e]) - | EFfiApp ("Basis", "attrifyString", [(EPrim (Prim.String s), _)]) => + | EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String s), _), _)]) => EPrim (Prim.String (attrifyString s)) - | EWrite (EFfiApp ("Basis", "attrifyString", [(EPrim (Prim.String s), _)]), loc) => + | EWrite (EFfiApp ("Basis", "attrifyString", [((EPrim (Prim.String s), _), _)]), loc) => EWrite (EPrim (Prim.String (attrifyString s)), loc) | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) => EFfiApp ("Basis", "attrifyString_w", [e]) - | EFfiApp ("Basis", "attrifyChar", [(EPrim (Prim.Char s), _)]) => + | EFfiApp ("Basis", "attrifyChar", [((EPrim (Prim.Char s), _), _)]) => EPrim (Prim.String (attrifyChar s)) - | EWrite (EFfiApp ("Basis", "attrifyChar", [(EPrim (Prim.Char s), _)]), loc) => + | EWrite (EFfiApp ("Basis", "attrifyChar", [((EPrim (Prim.Char s), _), _)]), loc) => EWrite (EPrim (Prim.String (attrifyChar s)), loc) | EWrite (EFfiApp ("Basis", "attrifyChar", [e]), _) => EFfiApp ("Basis", "attrifyChar_w", [e]) - | EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]) => + | EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String s), _), _)]) => EPrim (Prim.String s) - | EWrite (EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]), loc) => + | EWrite (EFfiApp ("Basis", "attrifyCss_class", [((EPrim (Prim.String s), _), _)]), loc) => EWrite (EPrim (Prim.String s), loc) | EWrite (EFfiApp ("Basis", "attrifyCss_class", [e]), _) => EFfiApp ("Basis", "attrifyString_w", [e]) - | EFfiApp ("Basis", "urlifyInt", [(EPrim (Prim.Int n), _)]) => + | EFfiApp ("Basis", "urlifyInt", [((EPrim (Prim.Int n), _), _)]) => EPrim (Prim.String (urlifyInt n)) - | EWrite (EFfiApp ("Basis", "urlifyInt", [(EPrim (Prim.Int n), _)]), loc) => + | EWrite (EFfiApp ("Basis", "urlifyInt", [((EPrim (Prim.Int n), _), _)]), loc) => EWrite (EPrim (Prim.String (urlifyInt n)), loc) | EWrite (EFfiApp ("Basis", "urlifyInt", [e]), _) => EFfiApp ("Basis", "urlifyInt_w", [e]) - | EFfiApp ("Basis", "urlifyFloat", [(EPrim (Prim.Float n), _)]) => + | EFfiApp ("Basis", "urlifyFloat", [((EPrim (Prim.Float n), _), _)]) => EPrim (Prim.String (urlifyFloat n)) - | EWrite (EFfiApp ("Basis", "urlifyFloat", [(EPrim (Prim.Float n), _)]), loc) => + | EWrite (EFfiApp ("Basis", "urlifyFloat", [((EPrim (Prim.Float n), _), _)]), loc) => EWrite (EPrim (Prim.String (urlifyFloat n)), loc) | EWrite (EFfiApp ("Basis", "urlifyFloat", [e]), _) => EFfiApp ("Basis", "urlifyFloat_w", [e]) - | EFfiApp ("Basis", "urlifyString", [(EPrim (Prim.String s), _)]) => + | EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String s), _), _)]) => EPrim (Prim.String (urlifyString s)) - | EWrite (EFfiApp ("Basis", "urlifyString", [(EPrim (Prim.String s), _)]), loc) => + | EWrite (EFfiApp ("Basis", "urlifyString", [((EPrim (Prim.String s), _), _)]), loc) => EWrite (EPrim (Prim.String (urlifyString s)), loc) | EWrite (EFfiApp ("Basis", "urlifyString", [e]), _) => EFfiApp ("Basis", "urlifyString_w", [e]) - | EFfiApp ("Basis", "urlifyBool", [(ECon (Enum, PConFfi {con = "True", ...}, NONE), _)]) => + | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]) => EPrim (Prim.String "1") - | EFfiApp ("Basis", "urlifyBool", [(ECon (Enum, PConFfi {con = "False", ...}, NONE), _)]) => + | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]) => EPrim (Prim.String "0") - | EWrite (EFfiApp ("Basis", "urlifyBool", [(ECon (Enum, PConFfi {con = "True", ...}, NONE), _)]), loc) => + | EWrite (EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]), loc) => EWrite (EPrim (Prim.String "1"), loc) - | EWrite (EFfiApp ("Basis", "urlifyBool", [(ECon (Enum, PConFfi {con = "False", ...}, NONE), _)]), loc) => + | EWrite (EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]), loc) => EWrite (EPrim (Prim.String "0"), loc) | EWrite (EFfiApp ("Basis", "urlifyBool", [e]), _) => EFfiApp ("Basis", "urlifyBool_w", [e]) - | EFfiApp ("Basis", "sqlifyInt", [(EPrim (Prim.Int n), _)]) => + | EFfiApp ("Basis", "sqlifyInt", [((EPrim (Prim.Int n), _), _)]) => EPrim (Prim.String (sqlifyInt n)) - | EFfiApp ("Basis", "sqlifyIntN", [(ENone _, _)]) => + | EFfiApp ("Basis", "sqlifyIntN", [((ENone _, _), _)]) => EPrim (Prim.String "NULL") - | EFfiApp ("Basis", "sqlifyIntN", [(ESome (_, (EPrim (Prim.Int n), _)), _)]) => + | EFfiApp ("Basis", "sqlifyIntN", [((ESome (_, (EPrim (Prim.Int n), _)), _), _)]) => EPrim (Prim.String (sqlifyInt n)) - | EFfiApp ("Basis", "sqlifyFloat", [(EPrim (Prim.Float n), _)]) => + | EFfiApp ("Basis", "sqlifyFloat", [((EPrim (Prim.Float n), _), _)]) => EPrim (Prim.String (sqlifyFloat n)) - | EFfiApp ("Basis", "sqlifyBool", [b as (_, loc)]) => + | EFfiApp ("Basis", "sqlifyBool", [(b as (_, loc), _)]) => optExp (ECase (b, [((PCon (Enum, PConFfi {mod = "Basis", datatyp = "bool", con = "True", arg = NONE}, NONE), loc), (EPrim (Prim.String (#trueString (Settings.currentDbms ()))), loc)), @@ -336,9 +336,9 @@ (EPrim (Prim.String (#falseString (Settings.currentDbms ()))), loc))], {disc = (TFfi ("Basis", "bool"), loc), result = (TFfi ("Basis", "string"), loc)}), loc) - | EFfiApp ("Basis", "sqlifyString", [(EPrim (Prim.String n), _)]) => + | EFfiApp ("Basis", "sqlifyString", [((EPrim (Prim.String n), _), _)]) => EPrim (Prim.String (sqlifyString n)) - | EFfiApp ("Basis", "sqlifyChar", [(EPrim (Prim.Char n), _)]) => + | EFfiApp ("Basis", "sqlifyChar", [((EPrim (Prim.Char n), _), _)]) => EPrim (Prim.String (sqlifyChar n)) | EWrite (ECase (discE, pes, {disc, ...}), loc) => @@ -418,52 +418,52 @@ | ESignalBind ((ESignalReturn e1, loc), e2) => optExp (EApp (e2, e1), loc) - | EFfiApp ("Basis", "bless", [(se as EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "bless", [((se as EPrim (Prim.String s), loc), _)]) => (if checkUrl s then () else ErrorMsg.errorAt loc ("Invalid URL " ^ s ^ " passed to 'bless'"); se) - | EFfiApp ("Basis", "checkUrl", [(se as EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "checkUrl", [((se as EPrim (Prim.String s), loc), _)]) => (if checkUrl s then ESome ((TFfi ("Basis", "string"), loc), (se, loc)) else ENone (TFfi ("Basis", "string"), loc)) - | EFfiApp ("Basis", "blessMime", [(se as EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "blessMime", [((se as EPrim (Prim.String s), loc), _)]) => (if Settings.checkMime s then () else ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessMime'"); se) - | EFfiApp ("Basis", "checkMime", [(se as EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "checkMime", [((se as EPrim (Prim.String s), loc), _)]) => (if Settings.checkMime s then ESome ((TFfi ("Basis", "string"), loc), (se, loc)) else ENone (TFfi ("Basis", "string"), loc)) - | EFfiApp ("Basis", "blessRequestHeader", [(se as EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "blessRequestHeader", [((se as EPrim (Prim.String s), loc), _)]) => (if Settings.checkRequestHeader s then () else ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessRequestHeader'"); se) - | EFfiApp ("Basis", "checkRequestHeader", [(se as EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "checkRequestHeader", [((se as EPrim (Prim.String s), loc), _)]) => (if Settings.checkRequestHeader s then ESome ((TFfi ("Basis", "string"), loc), (se, loc)) else ENone (TFfi ("Basis", "string"), loc)) - | EFfiApp ("Basis", "blessResponseHeader", [(se as EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "blessResponseHeader", [((se as EPrim (Prim.String s), loc), _)]) => (if Settings.checkResponseHeader s then () else ErrorMsg.errorAt loc ("Invalid string " ^ s ^ " passed to 'blessResponseHeader'"); se) - | EFfiApp ("Basis", "checkResponseHeader", [(se as EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "checkResponseHeader", [((se as EPrim (Prim.String s), loc), _)]) => (if Settings.checkResponseHeader s then ESome ((TFfi ("Basis", "string"), loc), (se, loc)) else ENone (TFfi ("Basis", "string"), loc)) - | EFfiApp ("Basis", "checkString", [(EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "checkString", [((EPrim (Prim.String s), loc), _)]) => let fun uwify (cs, acc) = case cs of @@ -491,7 +491,7 @@ EPrim (Prim.String s) end - | EFfiApp ("Basis", "viewify", [(EPrim (Prim.String s), loc)]) => + | EFfiApp ("Basis", "viewify", [((EPrim (Prim.String s), loc), _)]) => let fun uwify (cs, acc) = case cs of @@ -516,9 +516,9 @@ EPrim (Prim.String s) end - | EFfiApp ("Basis", "unAs", [(EPrim (Prim.String s), _)]) => + | EFfiApp ("Basis", "unAs", [((EPrim (Prim.String s), _), _)]) => EPrim (Prim.String (unAs s)) - | EFfiApp ("Basis", "unAs", [e']) => + | EFfiApp ("Basis", "unAs", [(e', _)]) => let fun parts (e as (_, loc)) = case #1 e of @@ -543,11 +543,11 @@ | NONE => e end - | EFfiApp ("Basis", "str1", [(EPrim (Prim.Char ch), _)]) => + | EFfiApp ("Basis", "str1", [((EPrim (Prim.Char ch), _), _)]) => EPrim (Prim.String (str ch)) - | EFfiApp ("Basis", "attrifyString", [(EFfiApp ("Basis", "str1", [e]), _)]) => + | EFfiApp ("Basis", "attrifyString", [((EFfiApp ("Basis", "str1", [e]), _), _)]) => EFfiApp ("Basis", "attrifyChar", [e]) - | EFfiApp ("Basis", "attrifyString_w", [(EFfiApp ("Basis", "str1", [e]), _)]) => + | EFfiApp ("Basis", "attrifyString_w", [((EFfiApp ("Basis", "str1", [e]), _), _)]) => EFfiApp ("Basis", "attrifyChar_w", [e]) | EBinop (_, "+", (EPrim (Prim.Int n1), _), (EPrim (Prim.Int n2), _)) => EPrim (Prim.Int (Int64.+ (n1, n2)))
--- a/src/mono_print.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/mono_print.sml Sat Jan 07 15:56:22 2012 -0500 @@ -167,7 +167,7 @@ string ".", string x, string "(", - p_list (p_exp env) es, + p_list (p_exp env o #1) es, string "))"] | EApp (e1, e2) => parenIf par (box [p_exp env e1, space,
--- a/src/mono_reduce.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/mono_reduce.sml Sat Jan 07 15:56:22 2012 -0500 @@ -390,20 +390,20 @@ | ENone _ => [] | ESome (_, e) => summarize d e | EFfi _ => [] - | EFfiApp ("Basis", "get_cookie", [e]) => + | EFfiApp ("Basis", "get_cookie", [(e, _)]) => summarize d e @ [ReadCookie] | EFfiApp ("Basis", "set_cookie", es) => - List.concat (map (summarize d) es) @ [WriteCookie] + List.concat (map (summarize d o #1) es) @ [WriteCookie] | EFfiApp ("Basis", "clear_cookie", es) => - List.concat (map (summarize d) es) @ [WriteCookie] + List.concat (map (summarize d o #1) es) @ [WriteCookie] | EFfiApp (m, x, es) => if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then - List.concat (map (summarize d) es) @ [if m = "Basis" andalso String.isSuffix "_w" x then - WritePage - else - Unsure] + List.concat (map (summarize d o #1) es) @ [if m = "Basis" andalso String.isSuffix "_w" x then + WritePage + else + Unsure] else - List.concat (map (summarize d) es) + List.concat (map (summarize d o #1) es) | EApp ((EFfi _, _), e) => summarize d e | EApp _ => let
--- a/src/mono_util.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/mono_util.sml Sat Jan 07 15:56:22 2012 -0500 @@ -156,6 +156,12 @@ fun mfe ctx e acc = S.bindP (mfe' ctx e acc, fe ctx) + and mfet ctx (e, t) = + S.bind2 (mfe ctx e, + fn e' => + S.map2 (mft t, + fn t' => (e', t'))) + and mfe' ctx (eAll as (e, loc)) = case e of EPrim _ => S.return2 eAll @@ -178,7 +184,7 @@ (ESome (t', e'), loc))) | EFfi _ => S.return2 eAll | EFfiApp (m, x, es) => - S.map2 (ListUtil.mapfold (fn e => mfe ctx e) es, + S.map2 (ListUtil.mapfold (fn e => mfet ctx e) es, fn es' => (EFfiApp (m, x, es'), loc)) | EApp (e1, e2) => @@ -479,7 +485,7 @@ | ENone _ => () | ESome (_, e) => appl e | EFfi _ => () - | EFfiApp (_, _, es) => app appl es + | EFfiApp (_, _, es) => app (appl o #1) es | EApp (e1, e2) => (appl e1; appl e2) | EAbs (_, _, _, e1) => appl e1 | EUnop (_, e1) => appl e1
--- a/src/monoize.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/monoize.sml Sat Jan 07 15:56:22 2012 -0500 @@ -509,7 +509,7 @@ | _ => case t of L'.TFfi ("Basis", "unit") => ((L'.EPrim (Prim.String ""), loc), fm) - | L'.TFfi (m, x) => ((L'.EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [e]), loc), fm) + | L'.TFfi (m, x) => ((L'.EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [(e, tAll)]), loc), fm) | L'.TRecord [] => ((L'.EPrim (Prim.String ""), loc), fm) | L'.TRecord ((x, t) :: xts) => @@ -944,7 +944,8 @@ (L'.TFun ((L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc), (L'.EAbs ("y", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc), - (L'.EFfiApp ("Basis", "eq_time", [(L'.ERel 1, loc), (L'.ERel 0, loc)]), loc)), loc)), loc), + (L'.EFfiApp ("Basis", "eq_time", [((L'.ERel 1, loc), (L'.TFfi ("Basis", "time"), loc)), + ((L'.ERel 0, loc), (L'.TFfi ("Basis", "time"), loc))]), loc)), loc)), loc), fm) | L.ECApp ((L.EFfi ("Basis", "mkEq"), _), t) => @@ -1169,7 +1170,8 @@ (L'.TFun ((L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc)), loc), (L'.EAbs ("y", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "bool"), loc), - (L'.EFfiApp ("Basis", s, [(L'.ERel 1, loc), (L'.ERel 0, loc)]), loc)), loc)), loc) + (L'.EFfiApp ("Basis", s, [((L'.ERel 1, loc), (L'.TFfi ("Basis", "time"), loc)), + ((L'.ERel 0, loc), (L'.TFfi ("Basis", "time"), loc))]), loc)), loc)), loc) in ordEx ((L'.TFfi ("Basis", "time"), loc), boolBin "lt_time", @@ -1368,14 +1370,14 @@ end | L.EFfiApp ("Basis", "recv", _) => poly () - | L.EFfiApp ("Basis", "float", [e]) => + | L.EFfiApp ("Basis", "float", [(e, t)]) => let val (e, fm) = monoExp (env, st, fm) e in - ((L'.EFfiApp ("Basis", "floatFromInt", [e]), loc), fm) + ((L'.EFfiApp ("Basis", "floatFromInt", [(e, monoType env t)]), loc), fm) end - | L.EFfiApp ("Basis", "sleep", [n]) => + | L.EFfiApp ("Basis", "sleep", [(n, _)]) => let val (n, fm) = monoExp (env, st, fm) n in @@ -1390,7 +1392,8 @@ ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), (L'.TSource, loc)), loc), (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TSource, loc), (L'.EFfiApp ("Basis", "new_client_source", - [(L'.EJavaScript (L'.Source t, (L'.ERel 1, loc)), loc)]), + [((L'.EJavaScript (L'.Source t, (L'.ERel 1, loc)), loc), + (L'.TSource, loc))]), loc)), loc)), loc), fm) @@ -1404,9 +1407,10 @@ (L'.EAbs ("v", t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc), (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), (L'.EFfiApp ("Basis", "set_client_source", - [(L'.ERel 2, loc), - (L'.EJavaScript (L'.Source t, - (L'.ERel 1, loc)), loc)]), + [((L'.ERel 2, loc), (L'.TSource, loc)), + ((L'.EJavaScript (L'.Source t, + (L'.ERel 1, loc)), loc), + t)]), loc)), loc)), loc)), loc), fm) end @@ -1418,7 +1422,7 @@ (L'.TFun ((L'.TRecord [], loc), t), loc), (L'.EAbs ("_", (L'.TRecord [], loc), t, (L'.EFfiApp ("Basis", "get_client_source", - [(L'.ERel 1, loc)]), + [((L'.ERel 1, loc), (L'.TSource, loc))]), loc)), loc)), loc), fm) end @@ -1430,12 +1434,12 @@ (L'.TFun ((L'.TRecord [], loc), t), loc), (L'.EAbs ("_", (L'.TRecord [], loc), t, (L'.EFfiApp ("Basis", "current", - [(L'.ERel 1, loc)]), + [((L'.ERel 1, loc), (L'.TSource, loc))]), loc)), loc)), loc), fm) end - | L.EFfiApp ("Basis", "spawn", [e]) => + | L.EFfiApp ("Basis", "spawn", [(e, _)]) => let val (e, fm) = monoExp (env, st, fm) e in @@ -1480,7 +1484,7 @@ in ((L'.EAbs ("c", s, (L'.TFun (un, s), loc), (L'.EAbs ("_", un, s, - (L'.EUnurlify ((L'.EFfiApp ("Basis", "get_cookie", [(L'.ERel 1, loc)]), loc), + (L'.EUnurlify ((L'.EFfiApp ("Basis", "get_cookie", [((L'.ERel 1, loc), s)]), loc), t, true), loc)), loc)), loc), fm) @@ -1502,13 +1506,13 @@ ((L'.EAbs ("c", s, (L'.TFun (rt, (L'.TFun (un, un), loc)), loc), (L'.EAbs ("r", rt, (L'.TFun (un, un), loc), (L'.EAbs ("_", un, un, - (L'.EFfiApp ("Basis", "set_cookie", [(L'.EPrim (Prim.String - (Settings.getUrlPrefix ())), - loc), - (L'.ERel 2, loc), - e, - fd "Expires", - fd "Secure"]) + (L'.EFfiApp ("Basis", "set_cookie", [((L'.EPrim (Prim.String + (Settings.getUrlPrefix ())), + loc), s), + ((L'.ERel 2, loc), s), + (e, s), + (fd "Expires", (L'.TOption (L'.TFfi ("Basis", "time"), loc), loc)), + (fd "Secure", (L'.TFfi ("Basis", "bool"), loc))]) , loc)), loc)), loc)), loc), fm) end @@ -1521,17 +1525,17 @@ ((L'.EAbs ("c", s, (L'.TFun (un, un), loc), (L'.EAbs ("_", un, un, (L'.EFfiApp ("Basis", "clear_cookie", - [(L'.EPrim (Prim.String - (Settings.getUrlPrefix ())), - loc), - (L'.ERel 1, loc)]), + [((L'.EPrim (Prim.String + (Settings.getUrlPrefix ())), + loc), s), + ((L'.ERel 1, loc), s)]), loc)), loc)), loc), fm) end | L.ECApp ((L.EFfi ("Basis", "channel"), _), t) => ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFfi ("Basis", "channel"), loc), - (L'.EFfiApp ("Basis", "new_channel", [(L'.ERecord [], loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "new_channel", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc)), loc), fm) | L.ECApp ((L.EFfi ("Basis", "send"), _), t) => let @@ -1543,8 +1547,8 @@ (L'.EAbs ("v", t, (L'.TFun ((L'.TRecord [], loc), (L'.TRecord [], loc)), loc), (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), (L'.EFfiApp ("Basis", "send", - [(L'.ERel 2, loc), - e]), + [((L'.ERel 2, loc), (L'.TFfi ("Basis", "channel"), loc)), + (e, (L'.TFfi ("Basis", "string"), loc))]), loc)), loc)), loc)), loc), fm) end @@ -1763,11 +1767,11 @@ ((L'.EAbs ("e", string, string, (L'.EStrcat ((L'.EPrim (Prim.String "CHECK "), loc), (L'.EFfiApp ("Basis", "checkString", - [(L'.ERel 0, loc)]), loc)), loc)), loc), + [((L'.ERel 0, loc), string)]), loc)), loc)), loc), fm) end - | L.EFfiApp ("Basis", "dml", [e]) => + | L.EFfiApp ("Basis", "dml", [(e, _)]) => let val (e, fm) = monoExp (env, st, fm) e in @@ -1775,7 +1779,7 @@ fm) end - | L.EFfiApp ("Basis", "tryDml", [e]) => + | L.EFfiApp ("Basis", "tryDml", [(e, _)]) => let val (e, fm) = monoExp (env, st, fm) e in @@ -1841,13 +1845,14 @@ strcat [sc ("uw_" ^ x ^ " = "), (L'.EFfiApp ("Basis", "unAs", - [(L'.EField - ((L'.ERel 2, - loc), - x), loc)]), loc)]) + [((L'.EField + ((L'.ERel 2, + loc), + x), loc), + s)]), loc)]) changed), sc " WHERE ", - (L'.EFfiApp ("Basis", "unAs", [(L'.ERel 0, loc)]), loc)]), + (L'.EFfiApp ("Basis", "unAs", [((L'.ERel 0, loc), s)]), loc)]), loc)), loc)), loc), fm) end @@ -1869,7 +1874,7 @@ strcat [sc "DELETE FROM ", (L'.ERel 1, loc), sc " WHERE ", - (L'.EFfiApp ("Basis", "unAs", [(L'.ERel 0, loc)]), loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "unAs", [((L'.ERel 0, loc), s)]), loc)]), loc)), loc), fm) end @@ -2108,43 +2113,43 @@ | L.EFfi ("Basis", "sql_int") => ((L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyInt", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyInt", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "int"), loc))]), loc)), loc), fm) | L.EFfi ("Basis", "sql_float") => ((L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyFloat", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyFloat", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "float"), loc))]), loc)), loc), fm) | L.EFfi ("Basis", "sql_bool") => ((L'.EAbs ("x", (L'.TFfi ("Basis", "bool"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyBool", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyBool", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "bool"), loc))]), loc)), loc), fm) | L.EFfi ("Basis", "sql_string") => ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyString", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyString", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))]), loc)), loc), fm) | L.EFfi ("Basis", "sql_char") => ((L'.EAbs ("x", (L'.TFfi ("Basis", "char"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyChar", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyChar", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "char"), loc))]), loc)), loc), fm) | L.EFfi ("Basis", "sql_time") => ((L'.EAbs ("x", (L'.TFfi ("Basis", "time"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyTime", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyTime", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "time"), loc))]), loc)), loc), fm) | L.EFfi ("Basis", "sql_blob") => ((L'.EAbs ("x", (L'.TFfi ("Basis", "blob"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyBlob", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyBlob", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "blob"), loc))]), loc)), loc), fm) | L.ECApp ((L.EFfi ("Basis", "sql_channel"), _), _) => ((L'.EAbs ("x", (L'.TFfi ("Basis", "channel"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyChannel", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyChannel", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "channel"), loc))]), loc)), loc), fm) | L.EFfi ("Basis", "sql_client") => ((L'.EAbs ("x", (L'.TFfi ("Basis", "client"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyClient", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyClient", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "client"), loc))]), loc)), loc), fm) | L.ECApp ((L.EFfi ("Basis", "sql_serialized"), _), _) => ((L'.EAbs ("x", (L'.TFfi ("Basis", "string"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "sqlifyString", [(L'.ERel 0, loc)]), loc)), loc), + (L'.EFfiApp ("Basis", "sqlifyString", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "string"), loc))]), loc)), loc), fm) | L.ECApp ((L.EFfi ("Basis", "sql_prim"), _), t) => let @@ -2430,26 +2435,26 @@ | L.EFfi ("Basis", "sql_no_limit") => ((L'.EPrim (Prim.String ""), loc), fm) - | L.EFfiApp ("Basis", "sql_limit", [e]) => + | L.EFfiApp ("Basis", "sql_limit", [(e, t)]) => let val (e, fm) = monoExp (env, st, fm) e in (strcat [ (L'.EPrim (Prim.String " LIMIT "), loc), - (L'.EFfiApp ("Basis", "sqlifyInt", [e]), loc) + (L'.EFfiApp ("Basis", "sqlifyInt", [(e, monoType env t)]), loc) ], fm) end | L.EFfi ("Basis", "sql_no_offset") => ((L'.EPrim (Prim.String ""), loc), fm) - | L.EFfiApp ("Basis", "sql_offset", [e]) => + | L.EFfiApp ("Basis", "sql_offset", [(e, t)]) => let val (e, fm) = monoExp (env, st, fm) e in (strcat [ (L'.EPrim (Prim.String " OFFSET "), loc), - (L'.EFfiApp ("Basis", "sqlifyInt", [e]), loc) + (L'.EFfiApp ("Basis", "sqlifyInt", [(e, monoType env t)]), loc) ], fm) end @@ -2914,13 +2919,13 @@ fm) end - | L.EFfiApp ("Basis", "nextval", [e]) => + | L.EFfiApp ("Basis", "nextval", [(e, _)]) => let val (e, fm) = monoExp (env, st, fm) e in ((L'.ENextval e, loc), fm) end - | L.EFfiApp ("Basis", "setval", [e1, e2]) => + | L.EFfiApp ("Basis", "setval", [(e1, _), (e2, _)]) => let val (e1, fm) = monoExp (env, st, fm) e1 val (e2, fm) = monoExp (env, st, fm) e2 @@ -2930,7 +2935,7 @@ | L.EFfi ("Basis", "null") => ((L'.EPrim (Prim.String ""), loc), fm) - | L.EFfiApp ("Basis", "classes", [s1, s2]) => + | L.EFfiApp ("Basis", "classes", [(s1, _), (s2, _)]) => let val (s1, fm) = monoExp (env, st, fm) s1 val (s2, fm) = monoExp (env, st, fm) s2 @@ -2947,13 +2952,13 @@ let val (se, fm) = monoExp (env, st, fm) se in - ((L'.EFfiApp ("Basis", "htmlifyString", [se]), loc), fm) + ((L'.EFfiApp ("Basis", "htmlifyString", [(se, (L'.TFfi ("Basis", "string"), loc))]), loc), fm) end | L.ECApp ( (L.ECApp ((L.EFfi ("Basis", "cdataChar"), _), _), _), _) => ((L'.EAbs ("ch", (L'.TFfi ("Basis", "char"), loc), (L'.TFfi ("Basis", "string"), loc), - (L'.EFfiApp ("Basis", "htmlifySpecialChar", [(L'.ERel 0, loc)]), loc)), loc), fm) + (L'.EFfiApp ("Basis", "htmlifySpecialChar", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "char"), loc))]), loc)), loc), fm) | L.EApp ( (L.EApp ( @@ -3010,7 +3015,7 @@ fun getTag (e, _) = case e of - L.EFfiApp ("Basis", tag, [(L.ERecord [], _)]) => (tag, []) + L.EFfiApp ("Basis", tag, [((L.ERecord [], _), _)]) => (tag, []) | L.EApp (e, (L.ERecord [], _)) => getTag' e | _ => (E.errorAt loc "Non-constant XML tag"; Print.eprefaces' [("Expression", CorePrint.p_exp env tag)]; @@ -3297,17 +3302,20 @@ "body" => let val onload = execify onload val onunload = execify onunload + val s = (L'.TFfi ("Basis", "string"), loc) in normal ("body", SOME (L'.EStrcat ((L'.EFfiApp ("Basis", "maybe_onload", - [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", - [(L'.ERecord [], loc)]), loc), - onload), loc)]), + [((L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", + [((L'.ERecord [], loc), + (L'.TRecord [], loc))]), loc), + onload), loc), + s)]), loc), (L'.EFfiApp ("Basis", "maybe_onunload", - [onunload]), + [(onunload, s)]), loc)), loc), - SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc)) + SOME (L'.EFfiApp ("Basis", "get_script", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc)) end | "dyn" => @@ -3645,7 +3653,7 @@ end val sigName = getSigName () - val sigSet = (L'.EFfiApp ("Basis", "sigString", [(L'.ERecord [], loc)]), loc) + val sigSet = (L'.EFfiApp ("Basis", "sigString", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc) val sigSet = (L'.EStrcat ((L'.EPrim (Prim.String ("<input type=\"hidden\" name=\"" ^ sigName ^ "\" value=\"")), loc), @@ -3788,7 +3796,7 @@ fm) end - | L.EFfiApp ("Basis", "url", [e]) => + | L.EFfiApp ("Basis", "url", [(e, _)]) => let val (e, fm) = monoExp (env, st, fm) e val (e, fm) = urlifyExp env fm (e, dummyTyp) @@ -3815,7 +3823,12 @@ | L.EFfi mx => ((L'.EFfi mx, loc), fm) | L.EFfiApp (m, x, es) => let - val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es + val (es, fm) = ListUtil.foldlMap (fn ((e, t), fm) => + let + val (e, fm) = monoExp (env, st, fm) e + in + ((e, monoType env t), fm) + end) fm es in ((L'.EFfiApp (m, x, es), loc), fm) end @@ -4054,7 +4067,7 @@ val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts val (e, fm) = monoExp (env, St.empty, fm) e - val e = (L'.EFfiApp ("Basis", "viewify", [e]), loc) + val e = (L'.EFfiApp ("Basis", "viewify", [(e, t')]), loc) in SOME (Env.pushENamed env x n t NONE s, fm, @@ -4110,7 +4123,7 @@ let fun policies (e, fm) = case #1 e of - L.EFfiApp ("Basis", "also", [e1, e2]) => + L.EFfiApp ("Basis", "also", [(e1, _), (e2, _)]) => let val (ps1, fm) = policies (e1, fm) val (ps2, fm) = policies (e2, fm) @@ -4129,7 +4142,7 @@ (e, L'.PolDelete) | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "mayUpdate"), _), _), _), _), _), e) => (e, L'.PolUpdate) - | L.EFfiApp ("Basis", "sendOwnIds", [e]) => + | L.EFfiApp ("Basis", "sendOwnIds", [(e, _)]) => (e, L'.PolSequence) | _ => (poly (); (e, L'.PolClient)) @@ -4186,7 +4199,7 @@ fun expunger () = let - val target = (L'.EFfiApp ("Basis", "sqlifyClient", [(L'.ERel 0, loc)]), loc) + val target = (L'.EFfiApp ("Basis", "sqlifyClient", [((L'.ERel 0, loc), (L'.TFfi ("Basis", "client"), loc))]), loc) fun doTable (tab, xts, e) = case xts of
--- a/src/prepare.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/prepare.sml Sat Jan 07 15:56:22 2012 -0500 @@ -67,25 +67,25 @@ case #1 e of EPrim (Prim.String s) => SOME (s :: ss, n) - | EFfiApp ("Basis", "strcat", [e1, e2]) => + | EFfiApp ("Basis", "strcat", [(e1, _), (e2, _)]) => (case prepString' (e1, ss, n) of NONE => NONE | SOME (ss, n) => prepString' (e2, ss, n)) - | EFfiApp ("Basis", "sqlifyInt", [e]) => doOne Int - | EFfiApp ("Basis", "sqlifyFloat", [e]) => doOne Float - | EFfiApp ("Basis", "sqlifyString", [e]) => doOne String - | EFfiApp ("Basis", "sqlifyBool", [e]) => doOne Bool - | EFfiApp ("Basis", "sqlifyTime", [e]) => doOne Time - | EFfiApp ("Basis", "sqlifyBlob", [e]) => doOne Blob - | EFfiApp ("Basis", "sqlifyChannel", [e]) => doOne Channel - | EFfiApp ("Basis", "sqlifyClient", [e]) => doOne Client + | EFfiApp ("Basis", "sqlifyInt", [_]) => doOne Int + | EFfiApp ("Basis", "sqlifyFloat", [_]) => doOne Float + | EFfiApp ("Basis", "sqlifyString", [_]) => doOne String + | EFfiApp ("Basis", "sqlifyBool", [_]) => doOne Bool + | EFfiApp ("Basis", "sqlifyTime", [_]) => doOne Time + | EFfiApp ("Basis", "sqlifyBlob", [_]) => doOne Blob + | EFfiApp ("Basis", "sqlifyChannel", [_]) => doOne Channel + | EFfiApp ("Basis", "sqlifyClient", [_]) => doOne Client | ECase (e, [((PNone _, _), (EPrim (Prim.String "NULL"), _)), ((PSome (_, (PVar _, _)), _), - (EFfiApp (m, x, [(ERel 0, _)]), _))], - _) => prepString' ((EFfiApp (m, x, [e]), #2 e), ss, n) + (EFfiApp (m, x, [((ERel 0, _), _)]), _))], + {disc = t, ...}) => prepString' ((EFfiApp (m, x, [(e, t)]), #2 e), ss, n) | ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _), @@ -130,7 +130,12 @@ | EFfi _ => (e, st) | EFfiApp (m, x, es) => let - val (es, st) = ListUtil.foldlMap prepExp st es + val (es, st) = ListUtil.foldlMap (fn ((e, t), st) => + let + val (e, st) = prepExp (e, st) + in + ((e, t), st) + end) st es in ((EFfiApp (m, x, es), loc), st) end @@ -260,9 +265,10 @@ (EPrim (Prim.String ("SELECT NEXTVAL('" ^ s ^ "')")), loc) | _ => let - val s' = (EFfiApp ("Basis", "strcat", [seq, (EPrim (Prim.String "')"), loc)]), loc) + val t = (TFfi ("Basis", "string"), loc) + val s' = (EFfiApp ("Basis", "strcat", [(seq, t), ((EPrim (Prim.String "')"), loc), t)]), loc) in - (EFfiApp ("Basis", "strcat", [(EPrim (Prim.String "SELECT NEXTVAL('"), loc), s']), loc) + (EFfiApp ("Basis", "strcat", [((EPrim (Prim.String "SELECT NEXTVAL('"), loc), t), (s', t)]), loc) end in case prepString (s, st) of
--- a/src/reduce.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/reduce.sml Sat Jan 07 15:56:22 2012 -0500 @@ -493,7 +493,7 @@ bindType (CFfi ("Basis", "signal"), loc) loc)], loc) | EFfi _ => all - | EFfiApp (m, f, es) => (EFfiApp (m, f, map (exp env) es), loc) + | EFfiApp (m, f, es) => (EFfiApp (m, f, map (fn (e, t) => (exp env e, con env t)) es), loc) (*| EApp ( (EApp
--- a/src/reduce_local.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/reduce_local.sml Sat Jan 07 15:56:22 2012 -0500 @@ -256,7 +256,7 @@ | ENamed _ => all | ECon (dk, pc, cs, eo) => (ECon (dk, patCon pc, map (con env) cs, Option.map (exp env) eo), loc) | EFfi _ => all - | EFfiApp (m, f, es) => (EFfiApp (m, f, map (exp env) es), loc) + | EFfiApp (m, f, es) => (EFfiApp (m, f, map (fn (e, t) => (exp env e, con env t)) es), loc) | EApp (e1, e2) => let
--- a/src/scriptcheck.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/scriptcheck.sml Sat Jan 07 15:56:22 2012 -0500 @@ -92,12 +92,12 @@ | EFfi ("Basis", x) => SS.member (basis, x) | EFfi _ => false | EFfiApp ("Basis", "maybe_onload", - [(EFfiApp ("Basis", "strcat", all as [_, (EPrim (Prim.String s), _)]), _)]) => - List.exists hasClient all + [((EFfiApp ("Basis", "strcat", all as [_, ((EPrim (Prim.String s), _), _)]), _), _)]) => + List.exists (hasClient o #1) all orelse (onload andalso size s > 0) | EFfiApp ("Basis", x, es) => SS.member (basis, x) - orelse List.exists hasClient es - | EFfiApp (_, _, es) => List.exists hasClient es + orelse List.exists (hasClient o #1) es + | EFfiApp (_, _, es) => List.exists (hasClient o #1) es | EApp (e, es) => hasClient e orelse List.exists hasClient es | EUnop (_, e) => hasClient e | EBinop (_, e1, e2) => hasClient e1 orelse hasClient e2
--- a/src/tag.sml Sat Jan 07 11:01:21 2012 -0500 +++ b/src/tag.sml Sat Jan 07 15:56:22 2012 -0500 @@ -170,22 +170,22 @@ end | _ => (e, s)) - | EFfiApp ("Basis", "url", [(ERel 0, _)]) => (e, s) + | EFfiApp ("Basis", "url", [((ERel 0, _), _)]) => (e, s) - | EFfiApp ("Basis", "url", [e]) => + | EFfiApp ("Basis", "url", [(e, t)]) => let val (e, s) = tagIt (e, Link, "Url", s) in - (EFfiApp ("Basis", "url", [e]), s) + (EFfiApp ("Basis", "url", [(e, t)]), s) end - | EFfiApp ("Basis", "effectfulUrl", [(ERel 0, _)]) => (e, s) + | EFfiApp ("Basis", "effectfulUrl", [((ERel 0, _), _)]) => (e, s) - | EFfiApp ("Basis", "effectfulUrl", [e]) => + | EFfiApp ("Basis", "effectfulUrl", [(e, t)]) => let val (e, s) = tagIt (e, Extern ReadCookieWrite, "Url", s) in - (EFfiApp ("Basis", "url", [e]), s) + (EFfiApp ("Basis", "url", [(e, t)]), s) end | EApp ((ENamed n, _), e') => @@ -193,11 +193,11 @@ val (_, _, eo, _) = E.lookupENamed env n in case eo of - SOME (EAbs (_, _, _, (EFfiApp ("Basis", "url", [(ERel 0, _)]), _)), _) => + SOME (EAbs (_, _, _, (EFfiApp ("Basis", "url", [((ERel 0, _), t)]), _)), _) => let val (e, s) = tagIt (e', Link, "Url", s) in - (EFfiApp ("Basis", "url", [e]), s) + (EFfiApp ("Basis", "url", [(e, t)]), s) end | _ => (e, s) end