Mercurial > urweb
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) |