comparison src/corify.sml @ 2038:ec2c7a22df0d

Fix off-by-one error in less-safe FFI wrapper generation
author Adam Chlipala <adam@chlipala.net>
date Sun, 13 Jul 2014 06:14:23 -0400
parents 403f0cc65b9c
children 3d10ae22abd6
comparison
equal deleted inserted replaced
2037:cf453f48d28b 2038:ec2c7a22df0d
1201 fun addLastBit (t : L'.con) = 1201 fun addLastBit (t : L'.con) =
1202 case #1 t of 1202 case #1 t of
1203 L'.TFun (dom, ran) => (L'.TFun (dom, addLastBit ran), #2 t) 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) 1204 | _ => (L'.TFun ((L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), t), loc)
1205 1205
1206 val e = (L'.EFfiApp (m, x, makeArgs (numArgs t' - 1, t', [])), loc) 1206 val isTrans = isTransactional t'
1207 val (e, tTrans) = if isTransactional t' then 1207 val e = (L'.EFfiApp (m, x, makeArgs (numArgs t' -
1208 (if isTrans then
1209 0
1210 else
1211 1), t', [])), loc)
1212 val (e, tTrans) = if isTrans then
1208 ((L'.EAbs ("_", (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), getRan t', e), loc), addLastBit t') 1213 ((L'.EAbs ("_", (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc), getRan t', e), loc), addLastBit t')
1209 else 1214 else
1210 (e, t') 1215 (e, t')
1211 val e = wrapAbs (0, t', tTrans, e) 1216 val e = wrapAbs (0, t', tTrans, e)
1212 in 1217 in
1214 | Source.BenignEffectful => Settings.addBenignEffectful name 1219 | Source.BenignEffectful => Settings.addBenignEffectful name
1215 | Source.ClientOnly => Settings.addClientOnly name 1220 | Source.ClientOnly => Settings.addClientOnly name
1216 | Source.ServerOnly => Settings.addServerOnly name 1221 | Source.ServerOnly => Settings.addServerOnly name
1217 | Source.JsFunc s => Settings.addJsFunc (name, s)) modes; 1222 | Source.JsFunc s => Settings.addJsFunc (name, s)) modes;
1218 1223
1219 if isTransactional t' andalso not (Settings.isBenignEffectful name) then 1224 if isTrans andalso not (Settings.isBenignEffectful name) then
1220 Settings.addEffectful name 1225 Settings.addEffectful name
1221 else 1226 else
1222 (); 1227 ();
1223 1228
1224 ([(L'.DVal (x, n, t', e, s), loc)], st) 1229 ([(L'.DVal (x, n, t', e, s), loc)], st)