# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1214143610 14400
# Node ID d37518b67bd27e91114a8fb0e78464290f7eb09b
# Parent  874e877d2c515c82312bb88d0bc20961b4adf167
Better FFI function handling

diff -r 874e877d2c51 -r d37518b67bd2 src/corify.sml
--- a/src/corify.sml	Sun Jun 22 10:00:25 2008 -0400
+++ b/src/corify.sml	Sun Jun 22 10:06:50 2008 -0400
@@ -263,7 +263,9 @@
               | St.Ffi (_, NONE) => raise Fail "corifyExp: Unknown type for FFI expression variable"
               | St.Ffi (m, SOME t) =>
                 case t of
-                    t as (L'.TFun _, _) =>
+                    (L'.TFun (dom as (L'.TRecord (L'.CRecord (_, []), _), _), ran), _) =>
+                    (L'.EAbs ("arg", dom, ran, (L'.EFfiApp (m, x, []), loc)), loc)
+                  | t as (L'.TFun _, _) =>
                     let
                         fun getArgs (all as (t, _), args) =
                             case t of
@@ -272,10 +274,10 @@
                                      
                         val (result, args) = getArgs (t, [])
 
-                        val (app, _) = foldl (fn (_, (app, n)) =>
-                                                 ((L'.EApp (app, (L'.ERel n, loc)), loc),
-                                                  n - 1)) ((L'.EFfi (m, x), loc),
-                                                           length args - 1) args
+                        val (actuals, _) = foldr (fn (_, (actuals, n)) =>
+                                                     ((L'.ERel n, loc) :: actuals,
+                                                      n + 1)) ([], 0) args
+                        val app = (L'.EFfiApp (m, x, actuals), loc)
                         val (abs, _, _) = foldr (fn (t, (abs, ran, n)) =>
                                                     ((L'.EAbs ("arg" ^ Int.toString n,
                                                                t,
diff -r 874e877d2c51 -r d37518b67bd2 tests/ffi.lac
--- a/tests/ffi.lac	Sun Jun 22 10:00:25 2008 -0400
+++ b/tests/ffi.lac	Sun Jun 22 10:06:50 2008 -0400
@@ -2,12 +2,15 @@
         type t
         type u
         val x : t
+        val y : u
+        val f0 : {} -> u
         val f1 : t -> t
         val f2 : t -> u -> t
 end
 
 type t' = Lib.t
 val x' : t' = Lib.x
+val f0' = Lib.f0
 val f1' = Lib.f1
 val f2' = Lib.f2
 
@@ -15,3 +18,5 @@
 
 type t'' = Lib'.t
 val x'' : t'' = Lib'.x
+
+val main = f2' (f1' x') (f0' {})