@@ -17,6 +17,7 @@ import Data.Char
1717import Numeric
1818import Data.List
1919import Data.Maybe
20+import Data.Word
2021import System.IO
2122import System.Directory
2223
@@ -53,6 +54,13 @@ data JSNum = JSInt Int
5354 deriving Eq
5455
5556
57+data JSWord = JSWord8 Word8
58+ | JSWord16 Word16
59+ | JSWord32 Word32
60+ | JSWord64 Word64
61+ deriving Eq
62+
63+
5664data JSAnnotation = JSConstructor deriving Eq
5765
5866
@@ -81,6 +89,7 @@ data JS = JSRaw String
8189 | JSArray [JS]
8290 | JSString String
8391 | JSNum JSNum
92+ | JSWord JSWord
8493 | JSAssign JS JS
8594 | JSAlloc String (Maybe JS)
8695 | JSIndex JS JS
@@ -257,6 +266,13 @@ compileJS (JSWhile cond body) =
257266 ++ compileJS body
258267 ++ "\n}"
259268
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+
260276jsTailcall :: JS -> JS
261277jsTailcall call =
262278 jsCall (idrRTNamespace ++ "tailcall") [
@@ -1441,6 +1457,7 @@ codegenJS_all target definitions includes filename outputType = do
14411457
14421458 match :: JS -> Bool
14431459 match (JSIdent "__IDRRT__bigInt") = True
1460+ match (JSWord (JSWord64 _)) = True
14441461 match (JSNum (JSInteger _)) = True
14451462 match js = False
14461463
@@ -1633,6 +1650,10 @@ translateConstant (AType (ATInt ITChar)) = JSType JSCharTy
16331650translateConstant PtrType = JSType JSPtrTy
16341651translateConstant Forgot = JSType JSForgotTy
16351652translateConstant (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)
16361657translateConstant c =
16371658 jsError $ "Unimplemented Constant: " ++ show c
16381659
@@ -1809,6 +1830,21 @@ translateExpression (SApp tc name vars)
18091830translateExpression (SOp op vars)
18101831 | LNoOp <- op = JSVar (last vars)
18111832
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+
18121848 | (LZExt _ ITBig) <- op = jsBigInt $ jsCall "String" [JSVar (last vars)]
18131849 | (LPlus (ATInt ITBig)) <- op
18141850 , (lhs:rhs:_) <- vars = invokeMeth lhs "add" [rhs]
@@ -1850,6 +1886,46 @@ translateExpression (SOp op vars)
18501886 | (LSGe ATFloat) <- op
18511887 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs
18521888
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+
18531929 | (LPlus _) <- op
18541930 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
18551931 | (LMinus _) <- op
@@ -1884,7 +1960,7 @@ translateExpression (SOp op vars)
18841960 , (arg:_) <- vars = JSPreOp "~" (JSVar arg)
18851961
18861962 | LStrConcat <- op
1887− , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1963+ , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
18881964 | LStrEq <- op
18891965 , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
18901966 | LStrLt <- op
@@ -1913,9 +1989,9 @@ translateExpression (SOp op vars)
19131989 | (LFloatInt ITNative) <- op
19141990 , (arg:_) <- vars = JSVar arg
19151991 | (LChInt ITNative) <- op
1916− , (arg:_) <- vars = JSProj (JSVar arg) "charCodeAt(0)"
1992+ , (arg:_) <- vars = jsCall "__IDRRT__charCode" [JSVar arg]
19171993 | (LIntCh ITNative) <- op
1918− , (arg:_) <- vars = jsCall "String.fromCharCode" [JSVar arg]
1994+ , (arg:_) <- vars = jsCall "__IDRRT__fromCharCode" [JSVar arg]
19191995
19201996 | LFExp <- op
19211997 , (arg:_) <- vars = jsCall "Math.exp" [JSVar arg]
@@ -1941,7 +2017,7 @@ translateExpression (SOp op vars)
19412017 , (arg:_) <- vars = jsCall "Math.ceil" [JSVar arg]
19422018
19432019 | LStrCons <- op
1944− , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
2020+ , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
19452021 | LStrHead <- op
19462022 , (arg:_) <- vars = JSIndex (JSVar arg) (JSNum (JSInt 0))
19472023 | LStrRev <- op
@@ -1959,7 +2035,7 @@ translateExpression (SOp op vars)
19592035
19602036 where
19612037 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)
19632039
19642040
19652041 invokeMeth :: LVar -> String -> [LVar] -> JS