git.iko.soy/Idris-dev
on master help sign in
Merge pull request #1058 from raichoo/javascript
6fab821Edwin Brady
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+81−5
@@ -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,13 @@ data JSNum = JSInt Int
53 deriving Eq
54 deriving Eq
54
55
55
56
57+data JSWord = JSWord8 Word8
58+ | JSWord16 Word16
59+ | JSWord32 Word32
60+ | JSWord64 Word64
61+ deriving Eq
62+
63+
56data JSAnnotation = JSConstructor deriving Eq
64data JSAnnotation = JSConstructor deriving Eq
57
65
58
66
@@ -81,6 +89,7 @@ data JS = JSRaw String
81 | JSArray [JS]
89 | JSArray [JS]
82 | JSString String
90 | JSString String
83 | JSNum JSNum
91 | JSNum JSNum
92+ | JSWord JSWord
84 | JSAssign JS JS
93 | JSAssign JS JS
85 | JSAlloc String (Maybe JS)
94 | JSAlloc String (Maybe JS)
86 | JSIndex JS JS
95 | JSIndex JS JS
@@ -257,6 +266,13 @@ compileJS (JSWhile cond body) =
257 ++ compileJS body
266 ++ compileJS body
258 ++ "\n}"
267 ++ "\n}"
259
268
269+compileJS (JSWord word)
270+ | JSWord8 b <- word = show b
271+ | JSWord16 b <- word = show b
272+ | JSWord32 b <- word = show b
273+ | JSWord64 b <- word = idrRTNamespace ++ "bigInt(\"" ++ show b ++ "\")"
274+
275+
260jsTailcall :: JS -> JS
276jsTailcall :: JS -> JS
261jsTailcall call =
277jsTailcall call =
262 jsCall (idrRTNamespace ++ "tailcall") [
278 jsCall (idrRTNamespace ++ "tailcall") [
@@ -1441,6 +1457,7 @@ codegenJS_all target definitions includes filename outputType = do
1441
1457
1442 match :: JS -> Bool
1458 match :: JS -> Bool
1443 match (JSIdent "__IDRRT__bigInt") = True
1459 match (JSIdent "__IDRRT__bigInt") = True
1460+ match (JSWord (JSWord64 _)) = True
1444 match (JSNum (JSInteger _)) = True
1461 match (JSNum (JSInteger _)) = True
1445 match js = False
1462 match js = False
1446
1463
@@ -1633,6 +1650,10 @@ translateConstant (AType (ATInt ITChar)) = JSType JSCharTy
1633translateConstant PtrType = JSType JSPtrTy
1650translateConstant PtrType = JSType JSPtrTy
1634translateConstant Forgot = JSType JSForgotTy
1651translateConstant Forgot = JSType JSForgotTy
1635translateConstant (BI i) = jsBigInt $ JSString (show i)
1652translateConstant (BI i) = jsBigInt $ JSString (show i)
1653+translateConstant (B8 b) = JSWord (JSWord8 b)
1654+translateConstant (B16 b) = JSWord (JSWord16 b)
1655+translateConstant (B32 b) = JSWord (JSWord32 b)
1656+translateConstant (B64 b) = JSWord (JSWord64 b)
1636translateConstant c =
1657translateConstant c =
1637 jsError $ "Unimplemented Constant: " ++ show c
1658 jsError $ "Unimplemented Constant: " ++ show c
1638
1659
@@ -1809,6 +1830,21 @@ translateExpression (SApp tc name vars)
1809translateExpression (SOp op vars)
1830translateExpression (SOp op vars)
1810 | LNoOp <- op = JSVar (last vars)
1831 | LNoOp <- op = JSVar (last vars)
1811
1832
1833+ | (LZExt (ITFixed IT8) ITNative) <- op = JSVar (last vars)
1834+
1835+ | (LLSHR (ITFixed IT8)) <- op
1836+ , (lhs:rhs:_) <- vars = translateBinaryOp ">>" lhs rhs
1837+
1838+ | (LLSHR (ITFixed IT16)) <- op
1839+ , (lhs:rhs:_) <- vars = translateBinaryOp ">>" lhs rhs
1840+
1841+ | (LLSHR (ITFixed IT32)) <- op
1842+ , (lhs:rhs:_) <- vars = translateBinaryOp ">>" lhs rhs
1843+
1844+ | (LLSHR (ITFixed IT64)) <- op
1845+ , (lhs:rhs:_) <- vars =
1846+ jsMeth (JSVar lhs) "shiftRight" [JSVar rhs]
1847+
1812 | (LZExt _ ITBig) <- op = jsBigInt $ jsCall "String" [JSVar (last vars)]
1848 | (LZExt _ ITBig) <- op = jsBigInt $ jsCall "String" [JSVar (last vars)]
1813 | (LPlus (ATInt ITBig)) <- op
1849 | (LPlus (ATInt ITBig)) <- op
1814 , (lhs:rhs:_) <- vars = invokeMeth lhs "add" [rhs]
1850 , (lhs:rhs:_) <- vars = invokeMeth lhs "add" [rhs]
@@ -1850,6 +1886,46 @@ translateExpression (SOp op vars)
1850 | (LSGe ATFloat) <- op
1886 | (LSGe ATFloat) <- op
1851 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs
1887 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs
1852
1888
1889+ | (LPlus (ATInt ITChar)) <- op
1890+ , (lhs:rhs:_) <- vars =
1891+ jsCall "__IDRRT__fromCharCode" [
1892+ JSBinOp "+" (
1893+ jsCall "__IDRRT__charCode" [JSVar lhs]
1894+ ) (
1895+ jsCall "__IDRRT__charCode" [JSVar rhs]
1896+ )
1897+ ]
1898+
1899+ | (LTrunc (ITFixed IT16) (ITFixed IT8)) <- op
1900+ , (arg:_) <- vars =
1901+ JSParens $ JSBinOp "&" (JSVar arg) (JSNum (JSInt 0xFF))
1902+
1903+ | (LTrunc (ITFixed IT32) (ITFixed IT16)) <- op
1904+ , (arg:_) <- vars =
1905+ JSParens $ JSBinOp "&" (JSVar arg) (JSNum (JSInt 0xFFFF))
1906+
1907+ | (LTrunc (ITFixed IT64) (ITFixed IT32)) <- op
1908+ , (arg:_) <- vars =
1909+ jsMeth (jsMeth (JSVar arg) "and" [
1910+ jsBigInt (JSString $ show 0xFFFFFFFF)
1911+ ]) "intValue" []
1912+
1913+ | (LTrunc ITBig (ITFixed IT64)) <- op
1914+ , (arg:_) <- vars =
1915+ jsMeth (JSVar arg) "and" [
1916+ jsBigInt (JSString $ show 0xFFFFFFFF)
1917+ ]
1918+
1919+ | (LAnd (ITFixed IT64)) <- op
1920+ , (lhs:rhs:_) <- vars =
1921+ jsMeth (JSVar lhs) "and" [JSVar rhs]
1922+
1923+ | (LPlus (ATInt (ITFixed IT64))) <- op
1924+ , (lhs:rhs:_) <- vars =
1925+ jsMeth (jsMeth (JSVar lhs) "add" [JSVar rhs]) "and" [
1926+ jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
1927+ ]
1928+
1853 | (LPlus _) <- op
1929 | (LPlus _) <- op
1854 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1930 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1855 | (LMinus _) <- op
1931 | (LMinus _) <- op
@@ -1884,7 +1960,7 @@ translateExpression (SOp op vars)
1884 , (arg:_) <- vars = JSPreOp "~" (JSVar arg)
1960 , (arg:_) <- vars = JSPreOp "~" (JSVar arg)
1885
1961
1886 | LStrConcat <- op
1962 | LStrConcat <- op
1887− , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1963+ , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
1888 | LStrEq <- op
1964 | LStrEq <- op
1889 , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
1965 , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
1890 | LStrLt <- op
1966 | LStrLt <- op
@@ -1913,9 +1989,9 @@ translateExpression (SOp op vars)
1913 | (LFloatInt ITNative) <- op
1989 | (LFloatInt ITNative) <- op
1914 , (arg:_) <- vars = JSVar arg
1990 , (arg:_) <- vars = JSVar arg
1915 | (LChInt ITNative) <- op
1991 | (LChInt ITNative) <- op
1916− , (arg:_) <- vars = JSProj (JSVar arg) "charCodeAt(0)"
1992+ , (arg:_) <- vars = jsCall "__IDRRT__charCode" [JSVar arg]
1917 | (LIntCh ITNative) <- op
1993 | (LIntCh ITNative) <- op
1918− , (arg:_) <- vars = jsCall "String.fromCharCode" [JSVar arg]
1994+ , (arg:_) <- vars = jsCall "__IDRRT__fromCharCode" [JSVar arg]
1919
1995
1920 | LFExp <- op
1996 | LFExp <- op
1921 , (arg:_) <- vars = jsCall "Math.exp" [JSVar arg]
1997 , (arg:_) <- vars = jsCall "Math.exp" [JSVar arg]
@@ -1941,7 +2017,7 @@ translateExpression (SOp op vars)
1941 , (arg:_) <- vars = jsCall "Math.ceil" [JSVar arg]
2017 , (arg:_) <- vars = jsCall "Math.ceil" [JSVar arg]
1942
2018
1943 | LStrCons <- op
2019 | LStrCons <- op
1944− , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
2020+ , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
1945 | LStrHead <- op
2021 | LStrHead <- op
1946 , (arg:_) <- vars = JSIndex (JSVar arg) (JSNum (JSInt 0))
2022 , (arg:_) <- vars = JSIndex (JSVar arg) (JSNum (JSInt 0))
1947 | LStrRev <- op
2023 | LStrRev <- op
@@ -1959,7 +2035,7 @@ translateExpression (SOp op vars)
1959
2035
1960 where
2036 where
1961 translateBinaryOp :: String -> LVar -> LVar -> JS
2037 translateBinaryOp :: String -> LVar -> LVar -> JS
1962− translateBinaryOp f lhs rhs = JSBinOp f (JSVar lhs) (JSVar rhs)
2038+ translateBinaryOp f lhs rhs = JSParens $ JSBinOp f (JSVar lhs) (JSVar rhs)
1963
2039
1964
2040
1965 invokeMeth :: LVar -> String -> [LVar] -> JS
2041 invokeMeth :: LVar -> String -> [LVar] -> JS
test/Makefile+1−1
@@ -11,7 +11,7 @@ test_java:
11 perl ./runtest.pl without sugar004 buffer001 --codegen Java
11 perl ./runtest.pl without sugar004 buffer001 --codegen Java
12
12
13test_js:
13test_js:
14− @perl ./runtest.pl without sugar004 reg029 io001 dsl002 io003 effects001 effects002 buffer001 bounded001 folding002 --codegen node
14+ @perl ./runtest.pl without sugar004 reg029 io001 dsl002 io003 effects001 effects002 buffer001 --codegen node
15
15
16test_llvm:
16test_llvm:
17 @perl ./runtest.pl without sugar004 io003 buffer001 --codegen llvm
17 @perl ./runtest.pl without sugar004 io003 buffer001 --codegen llvm