git.iko.soy/Idris-dev
on master help sign in
javascript: make FFI work with HOFs
commit2613689b013009837ac2990484385650db6102df authorraichoo <raichoo@googlemail.com> dateTue 28 May 2013, 22:22 (13 years ago) parent4cb3ab9
5 files changed+49−17
compare with master
unifiedsplit
js/Runtime-common.js+5 lib/IO.idr+18−10 src/IRTS/CodegenJavaScript.hs+8−1 src/IRTS/Compiler.hs+9−5 src/IRTS/Lang.hs+9−1
js/Runtime-common.js+5
@@ -16,6 +16,11 @@ __IDRRT__.Forgot = new __IDRRT__.Type('Forgot');
1616
1717/** @constructor */
1818__IDRRT__.Tailcall = function(f) { this.f = f };
19+__IDRRT__.ffiWrap = function(fid) {
20+ return function(arg) {
21+ return __IDR__.APPLY0(fid, arg);
22+ };
23+};
1924
2025/** @constructor */
2126__IDRRT__.Con = function(i,vars) {
lib/IO.idr+18−10
@@ -22,7 +22,13 @@ run__IO : IO () -> IO ()
2222run__IO v = io_bind v (\v' => io_return v')
2323
2424data 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
2632
2733FInt : FTy
2834FInt = FIntT ITNative
@@ -38,15 +44,17 @@ FLong = FIntT IT64
3844
3945interpFTy : FTy -> Type
4046interpFTy (FIntT ITNative) = Int
41−interpFTy (FIntT IT8) = Bits8
42−interpFTy (FIntT IT16) = Bits16
43−interpFTy (FIntT IT32) = Bits32
44−interpFTy (FIntT IT64) = Bits64
45−interpFTy FFloat = Float
46−interpFTy FString = String
47−interpFTy FPtr = Ptr
48−interpFTy (FAny t) = t
49−interpFTy FUnit = ()
47+interpFTy (FIntT IT8) = Bits8
48+interpFTy (FIntT IT16) = Bits16
49+interpFTy (FIntT IT32) = Bits32
50+interpFTy (FIntT IT64) = Bits64
51+interpFTy (FAny t) = t
52+interpFTy FFloat = Float
53+interpFTy FString = String
54+interpFTy FPtr = Ptr
55+interpFTy FUnit = ()
56+
57+interpFTy (FFunction a b) = interpFTy a -> interpFTy b
5058
5159ForeignTy : (xs:List FTy) -> (t:FTy) -> Type
5260ForeignTy Nil rt = IO (interpFTy rt)
src/IRTS/CodegenJavaScript.hs+8−1
@@ -404,7 +404,14 @@ translateExpression (SForeign _ _ fun args)
404404 index i = "[" ++ translateVariableName (snd i) ++ "]"
405405 assign v = '=' : translateVariableName (snd v)
406406 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
408415
409416translateExpression (SChkCase var cases) =
410417 "(function(e){\n"
src/IRTS/Compiler.hs+9−5
@@ -285,13 +285,17 @@ getFTypes tm = case unApply tm of
285285
286286mkIty' (P _ (UN ty) _) = mkIty ty
287287mkIty' (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
288290mkIty' _ = FAny
289291
290−mkIty "FFloat" = FDouble
291−mkIty "FChar" = FChar
292−mkIty "FString" = FString
293−mkIty "FPtr" = FPtr
294−mkIty "FUnit" = FUnit
292+mkIty "FFloat" = FDouble
293+mkIty "FChar" = FChar
294+mkIty "FString" = FString
295+mkIty "FPtr" = FPtr
296+mkIty "FUnit" = FUnit
297+mkIty "FFunction" = FFunction
298+mkIty "FFunctionIO" = FFunctionIO
295299
296300mkIntIty "ITNative" = FInt ITNative
297301mkIntIty "IT8" = FInt IT8
src/IRTS/Lang.hs+9−1
@@ -79,7 +79,15 @@ data PrimFn = LPlus IntTy | LMinus IntTy | LTimes IntTy
7979data FLang = LANG_C
8080 deriving (Show, Eq)
8181
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
8391 deriving (Show, Eq)
8492
8593data LAlt = LConCase Int Name [Name] LExp