git.iko.soy/Idris-dev
on master help sign in
javascript: pass more tests
8c3a1efraichoo
jsrts/Runtime-common.js+20
compare with master
unifiedsplit
@@ -28,3 +28,23 @@ var i$RESERVE = function(vm,n) {
28 for (var i = 0; i < n; ++i)
28 for (var i = 0; i < n; ++i)
29 vm.valstack[vm.valstack_top + i] = null;
29 vm.valstack[vm.valstack_top + i] = null;
30}
30}
31+
32+var __IDRRT__charCode = function(str) {
33+ var type = typeof str;
34+ if (type == "string")
35+ return str.charCodeAt(0);
36+ else
37+ return str;
38+}
39+
40+var __IDRRT__fromCharCode = function(chr) {
41+ var type = typeof chr;
42+ if (type == "string")
43+ return chr;
44+ else
45+ return String.fromCharCode(chr);
46+}
47+
48+var isNull = function(v) {
49+ return v == null;
50+}
src/IRTS/CodegenJavaScript.hs+38−12
@@ -1,5 +1,4 @@
1−{-# LANGUAGE PatternGuards #-}
1+{-# LANGUAGE PatternGuards #-}
2−
3module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where
2module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where
4
3
5import Idris.AbsSyntax hiding (TypeCase)
4import Idris.AbsSyntax hiding (TypeCase)
@@ -290,6 +289,10 @@ codegenJS_all target definitions includes filename outputType = do
290 jsbn <- readFile $ path ++ "jsbn/jsbn.js"
289 jsbn <- readFile $ path ++ "jsbn/jsbn.js"
291 let runtime = header ++ jsbn ++ idrRuntime ++ tgtRuntime
290 let runtime = header ++ jsbn ++ idrRuntime ++ tgtRuntime
292 writeFile filename $ runtime ++ concat code ++ main ++ invokeMain
291 writeFile filename $ runtime ++ concat code ++ main ++ invokeMain
292+ setPermissions filename (emptyPermissions { readable = True
293+ , executable = target == Node
294+ , writable = True
295+ })
293 where
296 where
294 main :: String
297 main :: String
295 main = compileJS $
298 main = compileJS $
@@ -585,6 +588,28 @@ jsIsNull js = JSBinOp "==" js JSNull
585jsBigInt :: JS -> JS
588jsBigInt :: JS -> JS
586jsBigInt = JSNum . JSInteger . JSBigIntExpr
589jsBigInt = JSNum . JSInteger . JSBigIntExpr
587
590
591+jsUnPackBits :: JS -> JS
592+jsUnPackBits js = JSIndex js $ JSNum (JSInt 0)
593+
594+
595+jsPackUBits8 :: JS -> JS
596+jsPackUBits8 js = JSNew "Uint8Array" [JSArray [js]]
597+
598+jsPackUBits16 :: JS -> JS
599+jsPackUBits16 js = JSNew "Uint16Array" [JSArray [js]]
600+
601+jsPackUBits32 :: JS -> JS
602+jsPackUBits32 js = JSNew "Uint32Array" [JSArray [js]]
603+
604+jsPackSBits8 :: JS -> JS
605+jsPackSBits8 js = JSNew "Int8Array" [JSArray [js]]
606+
607+jsPackSBits16 :: JS -> JS
608+jsPackSBits16 js = JSNew "Int16Array" [JSArray [js]]
609+
610+jsPackSBits32 :: JS -> JS
611+jsPackSBits32 js = JSNew "Int32Array" [JSArray [js]]
612+
588jsTAG :: JS -> JS
613jsTAG :: JS -> JS
589jsTAG js =
614jsTAG js =
590 JSTernary (jsIsNumber js `jsOr` jsIsNull js) (
615 JSTernary (jsIsNumber js `jsOr` jsIsNull js) (
@@ -635,9 +660,9 @@ jsOP reg op args = JSAssign (translateReg reg) jsOP'
635 jsOP'
660 jsOP'
636 | LNoOp <- op = translateReg (last args)
661 | LNoOp <- op = translateReg (last args)
637
662
638− {-| (LZExt (ITFixed IT8) ITNative) <- op = jsUnPackBits $ JSVar (last args)-}
663+ | (LZExt (ITFixed IT8) ITNative) <- op = jsUnPackBits $ translateReg (last args)
639− {-| (LZExt (ITFixed IT16) ITNative) <- op = jsUnPackBits $ JSVar (last args)-}
664+ | (LZExt (ITFixed IT16) ITNative) <- op = jsUnPackBits $ translateReg (last args)
640− {-| (LZExt (ITFixed IT32) ITNative) <- op = jsUnPackBits $ JSVar (last args)-}
665+ | (LZExt (ITFixed IT32) ITNative) <- op = jsUnPackBits $ translateReg (last args)
641
666
642 | (LZExt _ ITBig) <- op = jsBigInt $ JSApp (JSIdent "String") [translateReg (last args)]
667 | (LZExt _ ITBig) <- op = jsBigInt $ JSApp (JSIdent "String") [translateReg (last args)]
643 | (LPlus (ATInt ITBig)) <- op
668 | (LPlus (ATInt ITBig)) <- op
@@ -1206,16 +1231,17 @@ jsOP reg op args = JSAssign (translateReg reg) jsOP'
1206 , (arg:_) <- args = JSProj (translateReg arg) "split('').reverse().join('')"
1231 , (arg:_) <- args = JSProj (translateReg arg) "split('').reverse().join('')"
1207 | LStrIndex <- op
1232 | LStrIndex <- op
1208 , (lhs:rhs:_) <- args = JSIndex (translateReg lhs) (translateReg rhs)
1233 , (lhs:rhs:_) <- args = JSIndex (translateReg lhs) (translateReg rhs)
1209− {-| LStrTail <- op-}
1234+ | LStrTail <- op
1210− {-, (arg:_) <- args = let v = translateVariableName arg in-}
1235+ , (arg:_) <- args = let v = translateReg arg in
1211− {-JSApp (JSProj (JSIdent v) "substr") [-}
1236+ JSApp (JSProj v "substr") [
1212− {-JSNum (JSInt 1),-}
1237+ JSNum (JSInt 1),
1213− {-JSBinOp "-" (JSProj (JSIdent v) "length") (JSNum (JSInt 1))-}
1238+ JSBinOp "-" (JSProj v "length") (JSNum (JSInt 1))
1214− {-]-}
1239+ ]
1215 {-| LSystemInfo <- op-}
1240 {-| LSystemInfo <- op-}
1216 {-, (arg:_) <- args = jsCall "__IDRRT__systemInfo" [JSVar arg]-}
1241 {-, (arg:_) <- args = jsCall "__IDRRT__systemInfo" [JSVar arg]-}
1217 | LNullPtr <- op
1242 | LNullPtr <- op
1218 , (_) <- args = JSNull
1243 , (_) <- args = JSNull
1244+ | otherwise = JSError $ "Not implemented: " ++ show op
1219 where
1245 where
1220 translateBinaryOp :: String -> Reg -> Reg -> JS
1246 translateBinaryOp :: String -> Reg -> Reg -> JS
1221 translateBinaryOp op lhs rhs =
1247 translateBinaryOp op lhs rhs =
@@ -1258,7 +1284,7 @@ translateBC bc
1258 | CONSTCASE r c d <- bc = jsCONSTCASE r c d
1284 | CONSTCASE r c d <- bc = jsCONSTCASE r c d
1259 | PROJECT r l a <- bc = jsPROJECT r l a
1285 | PROJECT r l a <- bc = jsPROJECT r l a
1260 | OP r o a <- bc = jsOP r o a
1286 | OP r o a <- bc = jsOP r o a
1287+ | ERROR e <- bc = jsERROR e
1261 | otherwise = JSRaw $ show bc
1288 | otherwise = JSRaw $ show bc
1262 {-| PROJECTINTO _ _ _ <- bc = undefined-}
1289 {-| PROJECTINTO _ _ _ <- bc = undefined-}
1263− {-| ERROR e <- bc = jsERROR e-}
1264
1290