git.iko.soy/Idris-dev
on master help sign in
javascript: initial Bits8 support
64f7716raichoo
jsrts/Runtime-common.js+16
compare with master
unifiedsplit
@@ -34,3 +34,19 @@ var __IDRRT__tailcall = function(k) {
34
34
35 return ret;
35 return ret;
36};
36};
37+
38+var __IDRRT__charCode = function(str) {
39+ var type = typeof str;
40+ if (type == "string")
41+ return str.charCodeAt(0);
42+ else
43+ return str;
44+}
45+
46+var __IDRRT__fromCharCode = function(chr) {
47+ var type = typeof chr;
48+ if (type == "string")
49+ return chr;
50+ else
51+ return String.fromCharCode(chr);
52+}
src/IRTS/CodegenJavaScript.hs+28−4
@@ -17,6 +17,7 @@ import Data.Char
17import Numeric
17import Numeric
18import Data.List
18import Data.List
19import Data.Maybe
19import Data.Maybe
20+import Data.Word
20import System.IO
21import System.IO
21import System.Directory
22import System.Directory
22
23
@@ -53,6 +54,9 @@ data JSNum = JSInt Int
53 deriving Eq
54 deriving Eq
54
55
55
56
57+data JSWord = JSWord8 Word8 deriving Eq
58+
59+
56data JSAnnotation = JSConstructor deriving Eq
60data JSAnnotation = JSConstructor deriving Eq
57
61
58
62
@@ -81,6 +85,7 @@ data JS = JSRaw String
81 | JSArray [JS]
85 | JSArray [JS]
82 | JSString String
86 | JSString String
83 | JSNum JSNum
87 | JSNum JSNum
88+ | JSWord JSWord
84 | JSAssign JS JS
89 | JSAssign JS JS
85 | JSAlloc String (Maybe JS)
90 | JSAlloc String (Maybe JS)
86 | JSIndex JS JS
91 | JSIndex JS JS
@@ -257,6 +262,9 @@ compileJS (JSWhile cond body) =
257 ++ compileJS body
262 ++ compileJS body
258 ++ "\n}"
263 ++ "\n}"
259
264
265+compileJS (JSWord word)
266+ | JSWord8 b <- word = show b
267+
260jsTailcall :: JS -> JS
268jsTailcall :: JS -> JS
261jsTailcall call =
269jsTailcall call =
262 jsCall (idrRTNamespace ++ "tailcall") [
270 jsCall (idrRTNamespace ++ "tailcall") [
@@ -1633,6 +1641,7 @@ translateConstant (AType (ATInt ITChar)) = JSType JSCharTy
1633translateConstant PtrType = JSType JSPtrTy
1641translateConstant PtrType = JSType JSPtrTy
1634translateConstant Forgot = JSType JSForgotTy
1642translateConstant Forgot = JSType JSForgotTy
1635translateConstant (BI i) = jsBigInt $ JSString (show i)
1643translateConstant (BI i) = jsBigInt $ JSString (show i)
1644+translateConstant (B8 b) = JSWord (JSWord8 b)
1636translateConstant c =
1645translateConstant c =
1637 jsError $ "Unimplemented Constant: " ++ show c
1646 jsError $ "Unimplemented Constant: " ++ show c
1638
1647
@@ -1809,6 +1818,11 @@ translateExpression (SApp tc name vars)
1809translateExpression (SOp op vars)
1818translateExpression (SOp op vars)
1810 | LNoOp <- op = JSVar (last vars)
1819 | LNoOp <- op = JSVar (last vars)
1811
1820
1821+ | (LZExt (ITFixed IT8) ITNative) <- op = JSVar (last vars)
1822+
1823+ | (LLSHR (ITFixed IT8)) <- op
1824+ , (lhs:rhs:_) <- vars = translateBinaryOp ">>" lhs rhs
1825+
1812 | (LZExt _ ITBig) <- op = jsBigInt $ jsCall "String" [JSVar (last vars)]
1826 | (LZExt _ ITBig) <- op = jsBigInt $ jsCall "String" [JSVar (last vars)]
1813 | (LPlus (ATInt ITBig)) <- op
1827 | (LPlus (ATInt ITBig)) <- op
1814 , (lhs:rhs:_) <- vars = invokeMeth lhs "add" [rhs]
1828 , (lhs:rhs:_) <- vars = invokeMeth lhs "add" [rhs]
@@ -1850,6 +1864,16 @@ translateExpression (SOp op vars)
1850 | (LSGe ATFloat) <- op
1864 | (LSGe ATFloat) <- op
1851 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs
1865 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs
1852
1866
1867+ | (LPlus (ATInt ITChar)) <- op
1868+ , (lhs:rhs:_) <- vars =
1869+ jsCall "__IDRRT__fromCharCode" [
1870+ JSBinOp "+" (
1871+ jsCall "__IDRRT__charCode" [JSVar lhs]
1872+ ) (
1873+ jsCall "__IDRRT__charCode" [JSVar rhs]
1874+ )
1875+ ]
1876+
1853 | (LPlus _) <- op
1877 | (LPlus _) <- op
1854 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1878 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1855 | (LMinus _) <- op
1879 | (LMinus _) <- op
@@ -1884,7 +1908,7 @@ translateExpression (SOp op vars)
1884 , (arg:_) <- vars = JSPreOp "~" (JSVar arg)
1908 , (arg:_) <- vars = JSPreOp "~" (JSVar arg)
1885
1909
1886 | LStrConcat <- op
1910 | LStrConcat <- op
1887− , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1911+ , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
1888 | LStrEq <- op
1912 | LStrEq <- op
1889 , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
1913 , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
1890 | LStrLt <- op
1914 | LStrLt <- op
@@ -1913,9 +1937,9 @@ translateExpression (SOp op vars)
1913 | (LFloatInt ITNative) <- op
1937 | (LFloatInt ITNative) <- op
1914 , (arg:_) <- vars = JSVar arg
1938 , (arg:_) <- vars = JSVar arg
1915 | (LChInt ITNative) <- op
1939 | (LChInt ITNative) <- op
1916− , (arg:_) <- vars = JSProj (JSVar arg) "charCodeAt(0)"
1940+ , (arg:_) <- vars = jsCall "__IDRRT__charCode" [JSVar arg]
1917 | (LIntCh ITNative) <- op
1941 | (LIntCh ITNative) <- op
1918− , (arg:_) <- vars = jsCall "String.fromCharCode" [JSVar arg]
1942+ , (arg:_) <- vars = jsCall "__IDRRT__fromCharCode" [JSVar arg]
1919
1943
1920 | LFExp <- op
1944 | LFExp <- op
1921 , (arg:_) <- vars = jsCall "Math.exp" [JSVar arg]
1945 , (arg:_) <- vars = jsCall "Math.exp" [JSVar arg]
@@ -1941,7 +1965,7 @@ translateExpression (SOp op vars)
1941 , (arg:_) <- vars = jsCall "Math.ceil" [JSVar arg]
1965 , (arg:_) <- vars = jsCall "Math.ceil" [JSVar arg]
1942
1966
1943 | LStrCons <- op
1967 | LStrCons <- op
1944− , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1968+ , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
1945 | LStrHead <- op
1969 | LStrHead <- op
1946 , (arg:_) <- vars = JSIndex (JSVar arg) (JSNum (JSInt 0))
1970 , (arg:_) <- vars = JSIndex (JSVar arg) (JSNum (JSInt 0))
1947 | LStrRev <- op
1971 | LStrRev <- op