Mercurial > urweb
comparison src/corify.sml @ 50:d37518b67bd2
Better FFI function handling
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 22 Jun 2008 10:06:50 -0400 |
parents | 874e877d2c51 |
children | c1e21ab42896 |
comparison
equal
deleted
inserted
replaced
49:874e877d2c51 | 50:d37518b67bd2 |
---|---|
261 case St.lookupCoreByName st x of | 261 case St.lookupCoreByName st x of |
262 St.Normal n => (L'.ENamed n, loc) | 262 St.Normal n => (L'.ENamed n, loc) |
263 | St.Ffi (_, NONE) => raise Fail "corifyExp: Unknown type for FFI expression variable" | 263 | St.Ffi (_, NONE) => raise Fail "corifyExp: Unknown type for FFI expression variable" |
264 | St.Ffi (m, SOME t) => | 264 | St.Ffi (m, SOME t) => |
265 case t of | 265 case t of |
266 t as (L'.TFun _, _) => | 266 (L'.TFun (dom as (L'.TRecord (L'.CRecord (_, []), _), _), ran), _) => |
267 (L'.EAbs ("arg", dom, ran, (L'.EFfiApp (m, x, []), loc)), loc) | |
268 | t as (L'.TFun _, _) => | |
267 let | 269 let |
268 fun getArgs (all as (t, _), args) = | 270 fun getArgs (all as (t, _), args) = |
269 case t of | 271 case t of |
270 L'.TFun (dom, ran) => getArgs (ran, dom :: args) | 272 L'.TFun (dom, ran) => getArgs (ran, dom :: args) |
271 | _ => (all, rev args) | 273 | _ => (all, rev args) |
272 | 274 |
273 val (result, args) = getArgs (t, []) | 275 val (result, args) = getArgs (t, []) |
274 | 276 |
275 val (app, _) = foldl (fn (_, (app, n)) => | 277 val (actuals, _) = foldr (fn (_, (actuals, n)) => |
276 ((L'.EApp (app, (L'.ERel n, loc)), loc), | 278 ((L'.ERel n, loc) :: actuals, |
277 n - 1)) ((L'.EFfi (m, x), loc), | 279 n + 1)) ([], 0) args |
278 length args - 1) args | 280 val app = (L'.EFfiApp (m, x, actuals), loc) |
279 val (abs, _, _) = foldr (fn (t, (abs, ran, n)) => | 281 val (abs, _, _) = foldr (fn (t, (abs, ran, n)) => |
280 ((L'.EAbs ("arg" ^ Int.toString n, | 282 ((L'.EAbs ("arg" ^ Int.toString n, |
281 t, | 283 t, |
282 ran, | 284 ran, |
283 abs), loc), | 285 abs), loc), |