e725b8a · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

javascript: first HOF FFI attempt

commite725b8a3df270481ff9bf2d11141eaf42b4e035a authorraichoo <raichoo@googlemail.com> dateTue 24 Jun 2014, 14:30 (12 years ago) parent4830e91

2 files changed+79−2

compare with master

unifiedsplit

jsrts/Runtime-common.js+24 src/IRTS/CodegenJavaScript.hs+55−2

jsrts/Runtime-common.js+24

@@ -49,6 +49,30 @@ var i$CALL = function(fun,args) {

4949 i$callstack.push(fun);

5050}

5151

52+var i$ffiWrap = function(fid,oldbase,myoldbase) {

53+ return function() {

54+ i$callstack = [];

55+

56+ i$valstack_top += arguments.length;

57+ i$valstack[i$valstack_top] = fid

58+ for (var i = 1; i <= arguments.length; ++i)

59+ i$valstack[i$valstack_top + i] = arguments[i - 1];

60+ i$SLIDE(arguments.length + 1);

61+

62+ fid.app(oldbase,myoldbase);

63+

64+ while (i$callstack.length) {

65+ var func = i$callstack.pop();

66+ var args = i$callstack.pop();

67+ func.apply(this,args);

68+ }

69+

70+ i$callstack = i$vm.callstack;

71+

72+ return i$ret;

73+ }

74+}

75+

5276var i$charCode = function(str) {

5377 if (typeof str == "string")

5478 return str.charCodeAt(0);

src/IRTS/CodegenJavaScript.hs+55−2

@@ -132,6 +132,37 @@ data JS = JSRaw String

132132

133133data FFI = FFICode Char | FFIArg Int | FFIError String

134134

135+ffi :: String -> [String] -> String

136+ffi code args = let parsed = ffiParse code in

137+ case ffiError parsed of

138+ Just err -> error err

139+ Nothing -> renderFFI parsed args

140+ where

141+ ffiParse :: String -> [FFI]

142+ ffiParse "" = []

143+ ffiParse ['%'] = [FFIError $ "FFI - Invalid positional argument"]

144+ ffiParse ('%':'%':ss) = FFICode '%' : ffiParse ss

145+ ffiParse ('%':s:ss)

146+ | isDigit s =

147+ FFIArg (read $ s : takeWhile isDigit ss) : ffiParse (dropWhile isDigit ss)

148+ | otherwise =

149+ [FFIError $ "FFI - Invalid positional argument"]

150+ ffiParse (s:ss) = FFICode s : ffiParse ss

151+

152+

153+ ffiError :: [FFI] -> Maybe String

154+ ffiError [] = Nothing

155+ ffiError ((FFIError s):xs) = Just s

156+ ffiError (x:xs) = ffiError xs

157+

158+

159+ renderFFI :: [FFI] -> [String] -> String

160+ renderFFI [] _ = ""

161+ renderFFI ((FFICode c) : fs) args = c : renderFFI fs args

162+ renderFFI ((FFIArg i) : fs) args

163+ | i < length args && i >= 0 = args !! i ++ renderFFI fs args

164+ | otherwise = error "FFI - Argument index out of bounds"

165+

135166compileJS :: JS -> String

136167compileJS = compileJS' 0

137168

@@ -141,8 +172,8 @@ compileJS' indent JSNoop = ""

141172compileJS' indent (JSAnnotation annotation js) =

142173 "/** @" ++ show annotation ++ " */\n" ++ compileJS' indent js

143174

144−{-compileJS' indent (JSFFI raw args) =-}

145− {-ffi raw (map compileJS' indent args)-}

175+compileJS' indent (JSFFI raw args) =

176+ ffi raw (map (compileJS' indent) args)

146177

147178compileJS' indent (JSRaw code) =

148179 code

@@ -601,6 +632,28 @@ jsFOREIGN _ reg n args

601632 ) (

602633 JSBinOp "==" (translateReg lhs) (translateReg rhs)

603634 )

635+ | otherwise =

636+ JSAssign (

637+ translateReg reg

638+ ) (

639+ JSFFI n (map generateWrapper args)

640+ )

641+ where

642+ generateWrapper :: (FType, Reg) -> JS

643+ generateWrapper (ty, reg)

644+ | FFunction <- ty =

645+ JSApp (JSIdent "i$ffiWrap") [ translateReg reg

646+ , JSIdent "oldbase"

647+ , JSIdent "myoldbase"

648+ ]

649+ | FFunctionIO <- ty =

650+ JSApp (JSIdent "i$ffiWrap") [ translateReg reg

651+ , JSIdent "oldbase"

652+ , JSIdent "myoldbase"

653+ ]

654+

655+ generateWrapper (_, reg) =

656+ translateReg reg

604657

605658jsREBASE :: CompileInfo -> JS

606659jsREBASE _ = JSAssign jsSTACKBASE jsOLDBASE