Mercurial > urweb
diff src/monoize.sml @ 1104:72670131dace
Basis.serialize; separate file for mhash; run transactional finishers in reverse order; set needs_sig properly
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 31 Dec 2009 11:41:57 -0500 |
parents | 118ab9641a64 |
children | 52571ca9b777 |
line wrap: on
line diff
--- a/src/monoize.sml Wed Dec 30 09:52:18 2009 -0500 +++ b/src/monoize.sml Thu Dec 31 11:41:57 2009 -0500 @@ -162,6 +162,9 @@ (L'.TFfi ("Basis", "string"), loc) | L.CFfi ("Basis", "css_class") => (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) => + (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) => (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc) | L.CApp ((L.CFfi ("Basis", "source"), _), t) => @@ -1975,6 +1978,10 @@ ((L'.EAbs ("x", (L'.TFfi ("Basis", "client"), loc), (L'.TFfi ("Basis", "string"), loc), (L'.EFfiApp ("Basis", "sqlifyClient", [(L'.ERel 0, 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), + fm) | L.ECApp ((L.EFfi ("Basis", "sql_prim"), _), t) => let val t = monoType env t @@ -3235,6 +3242,22 @@ fm) end + | L.ECApp ((L.EFfi ("Basis", "serialize"), _), t) => + let + val t = monoType env t + val (e, fm) = urlifyExp env fm ((L'.ERel 0, loc), t) + in + ((L'.EAbs ("v", t, (L'.TFfi ("Basis", "string"), loc), e), loc), + fm) + end + | L.ECApp ((L.EFfi ("Basis", "deserialize"), _), t) => + let + val t = monoType env t + in + ((L'.EAbs ("v", (L'.TFfi ("Basis", "string"), loc), t, (L'.EUnurlify ((L'.ERel 0, loc), t), loc)), loc), + fm) + end + | L.EFfiApp ("Basis", "url", [e]) => let val (e, fm) = monoExp (env, st, fm) e @@ -3432,7 +3455,7 @@ fm, [(L'.DValRec vis, loc)]) end - | L.DExport (ek, n) => + | L.DExport (ek, n, b) => let val (_, t, _, s) = Env.lookupENamed env n @@ -3447,7 +3470,7 @@ val ts = map (monoType env) ts val ran = monoType env ran in - SOME (env, fm, [(L'.DExport (ek, s, n, ts, ran), loc)]) + SOME (env, fm, [(L'.DExport (ek, s, n, ts, ran, b), loc)]) end | L.DTable (x, n, (L.CRecord (_, xts), _), s, pe, _, ce, _) => let @@ -3538,8 +3561,8 @@ (* Calculate which exported functions need cookie signature protection *) val rcook = foldl (fn ((d, _), rcook) => case d of - L.DExport (L.Action L.ReadCookieWrite, n) => IS.add (rcook, n) - | L.DExport (L.Rpc L.ReadCookieWrite, n) => IS.add (rcook, n) + L.DExport (L.Action L.ReadCookieWrite, n, _) => IS.add (rcook, n) + | L.DExport (L.Rpc L.ReadCookieWrite, n, _) => IS.add (rcook, n) | _ => rcook) IS.empty file val () = readCookie := rcook