Mercurial > urweb

comparison src/corify.sml @ 2206:c1a62ce47083

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge.
author Ziv Scully <ziv@mit.edu>
date Tue, 27 May 2014 21:38:01 -0400
parents 403f0cc65b9c
children ec2c7a22df0d
comparison
equal deleted inserted replaced
2205:cdea39473c78 2206:c1a62ce47083
640 loc) 640 loc)
641 641
642 | L.EWrite e => (L'.EWrite (corifyExp st e), loc) 642 | L.EWrite e => (L'.EWrite (corifyExp st e), loc)
643 643
644 | L.ELet (x, t, e1, e2) => (L'.ELet (x, corifyCon st t, corifyExp st e1, corifyExp st e2), loc) 644 | L.ELet (x, t, e1, e2) => (L'.ELet (x, corifyCon st t, corifyExp st e1, corifyExp st e2), loc)
645
646 fun isTransactional (c, _) =
647 case c of
648 L'.TFun (_, c) => isTransactional c
649 | L'.CApp ((L'.CFfi ("Basis", "transaction"), _), _) => true
650 | _ => false
645 651
646 fun corifyDecl mods (all as (d, loc : EM.span), st) = 652 fun corifyDecl mods (all as (d, loc : EM.span), st) =
647 case d of 653 case d of
648 L.DCon (x, n, k, c) => 654 L.DCon (x, n, k, c) =>
649 let 655 let
968 corifyCon st all 974 corifyCon st all
969 | _ => corifyCon st all 975 | _ => corifyCon st all
970 in 976 in
971 transactify c 977 transactify c
972 end 978 end
973
974 fun isTransactional (c, _) =
975 case c of
976 L'.TFun (_, c) => isTransactional c
977 | L'.CApp ((L'.CFfi ("Basis", "transaction"), _), _) => true
978 | _ => false
979 in 979 in
980 if isTransactional c then 980 if isTransactional c then
981 let 981 let
982 val ffi = (m, x) 982 val ffi = (m, x)
983 in 983 in
1162 St.ENormal n => ([(L'.DOnError n, loc)], st) 1162 St.ENormal n => ([(L'.DOnError n, loc)], st)
1163 | _ => (ErrorMsg.errorAt loc "Wrong type of identifier for 'onError'"; 1163 | _ => (ErrorMsg.errorAt loc "Wrong type of identifier for 'onError'";
1164 ([], st)) 1164 ([], st))
1165 end 1165 end
1166 1166
1167 | L.DFfi (x, n, modes, t) =>
1168 let
1169 val m = case St.name st of
1170 [m] => m
1171 | _ => (ErrorMsg.errorAt loc "Used 'ffi' declaration beneath module top level";
1172 "")
1173
1174 val name = (m, x)
1175
1176 val (st, n) = St.bindVal st x n
1177 val s = doRestify Settings.Url (mods, x)
1178
1179 val t' = corifyCon st t
1180
1181 fun numArgs (t : L'.con) =
1182 case #1 t of
1183 L'.TFun (_, ran) => 1 + numArgs ran
1184 | _ => 0
1185
1186 fun makeArgs (i, t : L'.con, acc) =
1187 case #1 t of
1188 L'.TFun (dom, ran) => makeArgs (i-1, ran, ((L'.ERel i, loc), dom) :: acc)
1189 | _ => rev acc
1190
1191 fun wrapAbs (i, t : L'.con, tTrans, e) =
1192 case (#1 t, #1 tTrans) of
1193 (L'.TFun (dom, ran), L'.TFun (_, ran')) => (L'.EAbs ("x" ^ Int.toString i, dom, ran, wrapAbs (i+1, ran, ran', e)), loc)
1194 | _ => e
1195
1196 fun getRan (t : L'.con) =
1197 case #1 t of
1198 L'.TFun (_, ran) => getRan ran
1199 | _ => t
1200
1201 fun addLastBit (t : L'.con) =
1202 case #1 t of
1203 L'.TFun (dom, ran) => (L'.TFun (dom, addLastBit ran), #2 t)
1204 | _ => (L'.TFun ((L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), t), loc)
1205
1206 val e = (L'.EFfiApp (m, x, makeArgs (numArgs t' - 1, t', [])), loc)
1207 val (e, tTrans) = if isTransactional t' then
1208 ((L'.EAbs ("_", (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), getRan t', e), loc), addLastBit t')
1209 else
1210 (e, t')
1211 val e = wrapAbs (0, t', tTrans, e)
1212 in
1213 app (fn Source.Effectful => Settings.addEffectful name
1214 | Source.BenignEffectful => Settings.addBenignEffectful name
1215 | Source.ClientOnly => Settings.addClientOnly name
1216 | Source.ServerOnly => Settings.addServerOnly name
1217 | Source.JsFunc s => Settings.addJsFunc (name, s)) modes;
1218
1219 if isTransactional t' andalso not (Settings.isBenignEffectful name) then
1220 Settings.addEffectful name
1221 else
1222 ();
1223
1224 ([(L'.DVal (x, n, t', e, s), loc)], st)
1225 end
1226
1167 and corifyStr mods ((str, loc), st) = 1227 and corifyStr mods ((str, loc), st) =
1168 case str of 1228 case str of
1169 L.StrConst ds => 1229 L.StrConst ds =>
1170 let 1230 let
1171 val st = St.enter (st, mods) 1231 val st = St.enter (st, mods)
1235 | L.DDatabase _ => n 1295 | L.DDatabase _ => n
1236 | L.DCookie (_, _, n', _) => Int.max (n, n') 1296 | L.DCookie (_, _, n', _) => Int.max (n, n')
1237 | L.DStyle (_, _, n') => Int.max (n, n') 1297 | L.DStyle (_, _, n') => Int.max (n, n')
1238 | L.DTask _ => n 1298 | L.DTask _ => n
1239 | L.DPolicy _ => n 1299 | L.DPolicy _ => n
1240 | L.DOnError _ => n) 1300 | L.DOnError _ => n
1301 | L.DFfi (_, n', _, _) => Int.max (n, n'))
1241 0 ds 1302 0 ds
1242 1303
1243 and maxNameStr (str, _) = 1304 and maxNameStr (str, _) =
1244 case str of 1305 case str of
1245 L.StrConst ds => maxName ds 1306 L.StrConst ds => maxName ds