git.iko.soy/Idris-dev
on master help sign in
javascript: make FFI work with HOFs
2613689raichoo
js/Runtime-common.js+5
compare with master
unifiedsplit
@@ -16,6 +16,11 @@ __IDRRT__.Forgot = new __IDRRT__.Type('Forgot');
16
16
17/** @constructor */
17/** @constructor */
18__IDRRT__.Tailcall = function(f) { this.f = f };
18__IDRRT__.Tailcall = function(f) { this.f = f };
19+__IDRRT__.ffiWrap = function(fid) {
20+ return function(arg) {
21+ return __IDR__.APPLY0(fid, arg);
22+ };
23+};
19
24
20/** @constructor */
25/** @constructor */
21__IDRRT__.Con = function(i,vars) {
26__IDRRT__.Con = function(i,vars) {
lib/IO.idr+18−10
@@ -22,7 +22,13 @@ run__IO : IO () -> IO ()
22run__IO v = io_bind v (\v' => io_return v')
22run__IO v = io_bind v (\v' => io_return v')
23
23
24data IntTy = ITNative | IT8 | IT16 | IT32 | IT64
24data IntTy = ITNative | IT8 | IT16 | IT32 | IT64
25−data FTy = FIntT IntTy | FFloat | FString | FPtr | FAny Type | FUnit
25+data FTy = FIntT IntTy
26+ | FFunction FTy FTy
27+ | FFloat
28+ | FString
29+ | FPtr
30+ | FAny Type
31+ | FUnit
26
32
27FInt : FTy
33FInt : FTy
28FInt = FIntT ITNative
34FInt = FIntT ITNative
@@ -38,15 +44,17 @@ FLong = FIntT IT64
38
44
39interpFTy : FTy -> Type
45interpFTy : FTy -> Type
40interpFTy (FIntT ITNative) = Int
46interpFTy (FIntT ITNative) = Int
41−interpFTy (FIntT IT8) = Bits8
47+interpFTy (FIntT IT8) = Bits8
42−interpFTy (FIntT IT16) = Bits16
48+interpFTy (FIntT IT16) = Bits16
43−interpFTy (FIntT IT32) = Bits32
49+interpFTy (FIntT IT32) = Bits32
44−interpFTy (FIntT IT64) = Bits64
50+interpFTy (FIntT IT64) = Bits64
51+interpFTy (FAny t) = t
45−interpFTy FFloat = Float
52+interpFTy FFloat = Float
46−interpFTy FString = String
53+interpFTy FString = String
47−interpFTy FPtr = Ptr
54+interpFTy FPtr = Ptr
48−interpFTy (FAny t) = t
55+interpFTy FUnit = ()
49−interpFTy FUnit = ()
56+
57+interpFTy (FFunction a b) = interpFTy a -> interpFTy b
50
58
51ForeignTy : (xs:List FTy) -> (t:FTy) -> Type
59ForeignTy : (xs:List FTy) -> (t:FTy) -> Type
52ForeignTy Nil rt = IO (interpFTy rt)
60ForeignTy Nil rt = IO (interpFTy rt)
src/IRTS/CodegenJavaScript.hs+8−1
@@ -404,7 +404,14 @@ translateExpression (SForeign _ _ fun args)
404 index i = "[" ++ translateVariableName (snd i) ++ "]"
404 index i = "[" ++ translateVariableName (snd i) ++ "]"
405 assign v = '=' : translateVariableName (snd v)
405 assign v = '=' : translateVariableName (snd v)
406 arguments as =
406 arguments as =
407− '(' : intercalate "," (map (translateVariableName . snd) as) ++ ")"
407+ '(' : intercalate "," (map generateWrapper as) ++ ")"
408+
409+ generateWrapper (ffunc, name)
410+ | FFunction <- ffunc = "__IDRRT__.ffiWrap(" ++ translateVariableName name ++ ")"
411+ | FFunctionIO <- ffunc = "__IDRRT__.ffiWrap(" ++ translateVariableName name ++ ")"
412+
413+ generateWrapper (_, name) =
414+ translateVariableName name
408
415
409translateExpression (SChkCase var cases) =
416translateExpression (SChkCase var cases) =
410 "(function(e){\n"
417 "(function(e){\n"
src/IRTS/Compiler.hs+9−5
@@ -285,13 +285,17 @@ getFTypes tm = case unApply tm of
285
285
286mkIty' (P _ (UN ty) _) = mkIty ty
286mkIty' (P _ (UN ty) _) = mkIty ty
287mkIty' (App (P _ (UN "FIntT") _) (P _ (UN intTy) _)) = mkIntIty intTy
287mkIty' (App (P _ (UN "FIntT") _) (P _ (UN intTy) _)) = mkIntIty intTy
288+mkIty' (App (App (P _ (UN "FFunction") _) _) (App (P _ (UN "FAny") _) (App (P _ (UN "IO") _) _))) = FFunctionIO
289+mkIty' (App (App (P _ (UN "FFunction") _) _) _) = FFunction
288mkIty' _ = FAny
290mkIty' _ = FAny
289
291
290−mkIty "FFloat" = FDouble
292+mkIty "FFloat" = FDouble
291−mkIty "FChar" = FChar
293+mkIty "FChar" = FChar
292−mkIty "FString" = FString
294+mkIty "FString" = FString
293−mkIty "FPtr" = FPtr
295+mkIty "FPtr" = FPtr
294−mkIty "FUnit" = FUnit
296+mkIty "FUnit" = FUnit
297+mkIty "FFunction" = FFunction
298+mkIty "FFunctionIO" = FFunctionIO
295
299
296mkIntIty "ITNative" = FInt ITNative
300mkIntIty "ITNative" = FInt ITNative
297mkIntIty "IT8" = FInt IT8
301mkIntIty "IT8" = FInt IT8
src/IRTS/Lang.hs+9−1
@@ -79,7 +79,15 @@ data PrimFn = LPlus IntTy | LMinus IntTy | LTimes IntTy
79data FLang = LANG_C
79data FLang = LANG_C
80 deriving (Show, Eq)
80 deriving (Show, Eq)
81
81
82−data FType = FInt IntTy | FChar | FString | FUnit | FPtr | FDouble | FAny
82+data FType = FInt IntTy
83+ | FFunction
84+ | FFunctionIO
85+ | FChar
86+ | FString
87+ | FUnit
88+ | FPtr
89+ | FDouble
90+ | FAny
83 deriving (Show, Eq)
91 deriving (Show, Eq)
84
92
85data LAlt = LConCase Int Name [Name] LExp
93data LAlt = LConCase Int Name [Name] LExp