@@ -1,5 +1,4 @@
1−{-# LANGUAGE PatternGuards #-}
2−
1+{-# LANGUAGE PatternGuards #-}
32module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where
43
54import Idris.AbsSyntax hiding (TypeCase)
@@ -290,6 +289,10 @@ codegenJS_all target definitions includes filename outputType = do
290289 jsbn <- readFile $ path ++ "jsbn/jsbn.js"
291290 let runtime = header ++ jsbn ++ idrRuntime ++ tgtRuntime
292291 writeFile filename $ runtime ++ concat code ++ main ++ invokeMain
292+ setPermissions filename (emptyPermissions { readable = True
293+ , executable = target == Node
294+ , writable = True
295+ })
293296 where
294297 main :: String
295298 main = compileJS $
@@ -585,6 +588,28 @@ jsIsNull js = JSBinOp "==" js JSNull
585588jsBigInt :: JS -> JS
586589jsBigInt = JSNum . JSInteger . JSBigIntExpr
587590
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+
588613jsTAG :: JS -> JS
589614jsTAG js =
590615 JSTernary (jsIsNumber js `jsOr` jsIsNull js) (
@@ -635,9 +660,9 @@ jsOP reg op args = JSAssign (translateReg reg) jsOP'
635660 jsOP'
636661 | LNoOp <- op = translateReg (last args)
637662
638− {-| (LZExt (ITFixed IT8) ITNative) <- op = jsUnPackBits $ JSVar (last args)-}
639− {-| (LZExt (ITFixed IT16) ITNative) <- op = jsUnPackBits $ JSVar (last args)-}
640− {-| (LZExt (ITFixed IT32) ITNative) <- op = jsUnPackBits $ JSVar (last args)-}
663+ | (LZExt (ITFixed IT8) ITNative) <- op = jsUnPackBits $ translateReg (last args)
664+ | (LZExt (ITFixed IT16) ITNative) <- op = jsUnPackBits $ translateReg (last args)
665+ | (LZExt (ITFixed IT32) ITNative) <- op = jsUnPackBits $ translateReg (last args)
641666
642667 | (LZExt _ ITBig) <- op = jsBigInt $ JSApp (JSIdent "String") [translateReg (last args)]
643668 | (LPlus (ATInt ITBig)) <- op
@@ -1206,16 +1231,17 @@ jsOP reg op args = JSAssign (translateReg reg) jsOP'
12061231 , (arg:_) <- args = JSProj (translateReg arg) "split('').reverse().join('')"
12071232 | LStrIndex <- op
12081233 , (lhs:rhs:_) <- args = JSIndex (translateReg lhs) (translateReg rhs)
1209− {-| LStrTail <- op-}
1210− {-, (arg:_) <- args = let v = translateVariableName arg in-}
1211− {-JSApp (JSProj (JSIdent v) "substr") [-}
1212− {-JSNum (JSInt 1),-}
1213− {-JSBinOp "-" (JSProj (JSIdent v) "length") (JSNum (JSInt 1))-}
1214− {-]-}
1234+ | LStrTail <- op
1235+ , (arg:_) <- args = let v = translateReg arg in
1236+ JSApp (JSProj v "substr") [
1237+ JSNum (JSInt 1),
1238+ JSBinOp "-" (JSProj v "length") (JSNum (JSInt 1))
1239+ ]
12151240 {-| LSystemInfo <- op-}
12161241 {-, (arg:_) <- args = jsCall "__IDRRT__systemInfo" [JSVar arg]-}
12171242 | LNullPtr <- op
12181243 , (_) <- args = JSNull
1244+ | otherwise = JSError $ "Not implemented: " ++ show op
12191245 where
12201246 translateBinaryOp :: String -> Reg -> Reg -> JS
12211247 translateBinaryOp op lhs rhs =
@@ -1258,7 +1284,7 @@ translateBC bc
12581284 | CONSTCASE r c d <- bc = jsCONSTCASE r c d
12591285 | PROJECT r l a <- bc = jsPROJECT r l a
12601286 | OP r o a <- bc = jsOP r o a
1287+ | ERROR e <- bc = jsERROR e
12611288 | otherwise = JSRaw $ show bc
12621289 {-| PROJECTINTO _ _ _ <- bc = undefined-}
1263− {-| ERROR e <- bc = jsERROR e-}
12641290