Mercurial > urweb

comparison src/monoize.sml @ 462:21bb5bbba2e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Setting a cookie
author Adam Chlipala <adamc@hcoop.net>
date Thu, 06 Nov 2008 11:29:16 -0500
parents 222cbc1da232
children bb27c7efcd90
comparison
equal deleted inserted replaced
461:5c9606deacb6 462:21bb5bbba2e9
131 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) => 131 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
132 (L'.TFfi ("Basis", "string"), loc) 132 (L'.TFfi ("Basis", "string"), loc)
133 133
134 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) => 134 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
135 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc) 135 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
136 | L.CApp ((L.CFfi ("Basis", "http_cookie"), _), _) =>
137 (L'.TFfi ("Basis", "string"), loc)
136 | L.CApp ((L.CFfi ("Basis", "sql_table"), _), _) => 138 | L.CApp ((L.CFfi ("Basis", "sql_table"), _), _) =>
137 (L'.TFfi ("Basis", "string"), loc) 139 (L'.TFfi ("Basis", "string"), loc)
138 | L.CFfi ("Basis", "sql_sequence") => 140 | L.CFfi ("Basis", "sql_sequence") =>
139 (L'.TFfi ("Basis", "string"), loc) 141 (L'.TFfi ("Basis", "string"), loc)
140 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _) => 142 | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_query"), _), _), _), _) =>
942 (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc), 944 (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc),
943 (L'.ERecord [], loc)), 945 (L'.ERecord [], loc)),
944 loc)), loc)), loc)), loc)), loc), 946 loc)), loc)), loc)), loc)), loc),
945 fm) 947 fm)
946 end 948 end
949
950 | L.ECApp ((L.EFfi ("Basis", "getCookie"), _), t) =>
951 let
952 val s = (L'.TFfi ("Basis", "string"), loc)
953 val un = (L'.TRecord [], loc)
954 val t = monoType env t
955 in
956 ((L'.EAbs ("c", s, (L'.TFun (un, s), loc),
957 (L'.EAbs ("_", un, s,
958 (L'.EPrim (Prim.String "Cookie!"), loc)), loc)), loc),
959 fm)
960 end
961
962 | L.ECApp ((L.EFfi ("Basis", "setCookie"), _), t) =>
963 let
964 val s = (L'.TFfi ("Basis", "string"), loc)
965 val un = (L'.TRecord [], loc)
966 val t = monoType env t
967 val (e, fm) = urlifyExp env fm ((L'.ERel 1, loc), t)
968 in
969 ((L'.EAbs ("c", s, (L'.TFun (t, (L'.TFun (un, un), loc)), loc),
970 (L'.EAbs ("v", t, (L'.TFun (un, un), loc),
971 (L'.EAbs ("_", un, un,
972 (L'.EFfiApp ("Basis", "set_cookie", [(L'.ERel 2, loc), e]), loc)),
973 loc)), loc)), loc),
974 fm)
975 end
947 976
948 | L.EFfiApp ("Basis", "dml", [e]) => 977 | L.EFfiApp ("Basis", "dml", [e]) =>
949 let 978 let
950 val (e, fm) = monoExp (env, st, fm) e 979 val (e, fm) = monoExp (env, st, fm) e
951 val un = (L'.TRecord [], loc) 980 val un = (L'.TRecord [], loc)
2057 fm, 2086 fm,
2058 [(L'.DSequence s, loc), 2087 [(L'.DSequence s, loc),
2059 (L'.DVal (x, n, t', e, s), loc)]) 2088 (L'.DVal (x, n, t', e, s), loc)])
2060 end 2089 end
2061 | L.DDatabase s => SOME (env, fm, [(L'.DDatabase s, loc)]) 2090 | L.DDatabase s => SOME (env, fm, [(L'.DDatabase s, loc)])
2091 | L.DCookie (x, n, t, s) =>
2092 let
2093 val t = (L.CFfi ("Basis", "string"), loc)
2094 val t' = (L'.TFfi ("Basis", "string"), loc)
2095 val e = (L'.EPrim (Prim.String s), loc)
2096 in
2097 SOME (Env.pushENamed env x n t NONE s,
2098 fm,
2099 [(L'.DVal (x, n, t', e, s), loc)])
2100 end
2062 end 2101 end
2063 2102
2064 fun monoize env ds = 2103 fun monoize env ds =
2065 let 2104 let
2066 val p = !urlPrefix 2105 val p = !urlPrefix