cd09f2e · Idris-dev · git.iko.soy

src/IRTS/CodegenC.hs+14−6

compare with master

unifiedsplit

@@ -811,12 +811,7 @@ genWrapper (desc, tag) = ret ++ " " ++ wrapperName tag ++ "(" ++

811 indent 1 ++ "RESERVE(" ++ show (len + 1) ++ ");\n" ++

812 indent 1 ++ "allocCon(REG1, vm, " ++ show tag ++ ",0 , 0);\n" ++

813 indent 1 ++ "TOP(0) = REG1;\n" ++

814−

815− push 1 argList ++

814+ applyArgs argList ++

816− indent 1 ++ "STOREOLD;\n" ++

817− indent 1 ++ "BASETOP(0);\n" ++

818− indent 1 ++ "ADDTOP(" ++ show (len + 1) ++ ");\n" ++

819− indent 1 ++ "CALL(_idris__123_APPLY0_125_);\n" ++

820 if ret /= "void"

815 if ret /= "void"

821 then indent 1 ++ "ret = " ++ irts_c (toFType ft) "RVAL" ++ ";\n"

816 then indent 1 ++ "ret = " ++ irts_c (toFType ft) "RVAL" ++ ";\n"

822 ++ indent 1 ++ "return ret;\n}\n\n"

817 ++ indent 1 ++ "return ret;\n}\n\n"

@@ -825,6 +820,19 @@ genWrapper (desc, tag) = ret ++ " " ++ wrapperName tag ++ "(" ++

825 (ret, ft) = rty desc

820 (ret, ft) = rty desc

826 argList = zip (args desc) [0..]

821 argList = zip (args desc) [0..]

827 len = length argList

822 len = length argList

823+

824+ applyArgs (x:y:xs) = push 1 [x] ++

825+ indent 1 ++ "STOREOLD;\n" ++

826+ indent 1 ++ "BASETOP(0);\n" ++

827+ indent 1 ++ "ADDTOP(2);\n" ++

828+ indent 1 ++ "CALL(_idris__123_APPLY0_125_);\n" ++

829+ indent 1 ++ "TOP(0)=REG1;\n" ++

830+ applyArgs (y:xs)

831+ applyArgs x = push 1 x ++

832+ indent 1 ++ "STOREOLD;\n" ++

833+ indent 1 ++ "BASETOP(0);\n" ++

834+ indent 1 ++ "ADDTOP(" ++ show (length x + 1) ++ ");\n" ++

835+ indent 1 ++ "CALL(_idris__123_APPLY0_125_);\n"

828 renderArgs [] = "void"

836 renderArgs [] = "void"

829 renderArgs [((s, _), n)] = s ++ " a" ++ (show n)

837 renderArgs [((s, _), n)] = s ++ " a" ++ (show n)

830 renderArgs (((s, _), n):xs) = s ++ " a" ++ (show n) ++ ", " ++

838 renderArgs (((s, _), n):xs) = s ++ " a" ++ (show n) ++ ", " ++

test/ffi007/expected+1

@@ -6,3 +6,4 @@ After calling callback

600000377

7I'm dynamic 3

86

9+7

test/ffi007/ffi007.c+4

@@ -28,3 +28,7 @@ int dynamic_fn(int i) {

28callback test_ffi6(void) {

29 return &dynamic_fn;

30}

31+

32+void test_mulpar(void (*fn)(int, int)) {

33+ fn(3,4);

34+}

test/ffi007/ffi007.h+2

@@ -9,3 +9,5 @@ void test_ffi2(int (*cb)(char*));

9void test_ffi3(void (*cb)(void));

10

11callback test_ffi6(void);

12+

13+void test_mulpar(void (*fn)(int, int));

test/ffi007/ffi007.idr+9

@@ -34,6 +34,14 @@ test6 = foreign FFI_C "test_ffi6" (IO Ptr)

34test7 : Ptr -> Int -> IO Int

35test7 fnptr i = foreign FFI_C "%dynamic" (Ptr -> Int -> IO Int) fnptr i

36

37+adder : Int -> Int -> ()

38+adder x y = unsafePerformIO $ do

39+ printLn $ x + y

40+

41+test8 : IO ()

42+test8 = foreign FFI_C "test_mulpar" (CFnPtr (Int -> Int -> ()) -> IO ())

43+ (MkCFnPtr adder)

44+

37main : IO ()

45main : IO ()

38main = do

46main = do

39 test

47 test

@@ -46,4 +54,5 @@ main = do

46 fptr <- test6

54 fptr <- test6

47 i <- test7 fptr 3

55 i <- test7 fptr 3

48 printLn i

56 printLn i

57+ test8

49 return ()

58 return ()