@@ -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,9 @@ data JSNum = JSInt Int
5354 deriving Eq
5455
5556
57+data JSWord = JSWord8 Word8 deriving Eq
58+
59+
5660data JSAnnotation = JSConstructor deriving Eq
5761
5862
@@ -81,6 +85,7 @@ data JS = JSRaw String
8185 | JSArray [JS]
8286 | JSString String
8387 | JSNum JSNum
88+ | JSWord JSWord
8489 | JSAssign JS JS
8590 | JSAlloc String (Maybe JS)
8691 | JSIndex JS JS
@@ -257,6 +262,9 @@ compileJS (JSWhile cond body) =
257262 ++ compileJS body
258263 ++ "\n}"
259264
265+compileJS (JSWord word)
266+ | JSWord8 b <- word = show b
267+
260268jsTailcall :: JS -> JS
261269jsTailcall call =
262270 jsCall (idrRTNamespace ++ "tailcall") [
@@ -1633,6 +1641,7 @@ translateConstant (AType (ATInt ITChar)) = JSType JSCharTy
16331641translateConstant PtrType = JSType JSPtrTy
16341642translateConstant Forgot = JSType JSForgotTy
16351643translateConstant (BI i) = jsBigInt $ JSString (show i)
1644+translateConstant (B8 b) = JSWord (JSWord8 b)
16361645translateConstant c =
16371646 jsError $ "Unimplemented Constant: " ++ show c
16381647
@@ -1809,6 +1818,11 @@ translateExpression (SApp tc name vars)
18091818translateExpression (SOp op vars)
18101819 | LNoOp <- op = JSVar (last vars)
18111820
1821+ | (LZExt (ITFixed IT8) ITNative) <- op = JSVar (last vars)
1822+
1823+ | (LLSHR (ITFixed IT8)) <- op
1824+ , (lhs:rhs:_) <- vars = translateBinaryOp ">>" lhs rhs
1825+
18121826 | (LZExt _ ITBig) <- op = jsBigInt $ jsCall "String" [JSVar (last vars)]
18131827 | (LPlus (ATInt ITBig)) <- op
18141828 , (lhs:rhs:_) <- vars = invokeMeth lhs "add" [rhs]
@@ -1850,6 +1864,16 @@ translateExpression (SOp op vars)
18501864 | (LSGe ATFloat) <- op
18511865 , (lhs:rhs:_) <- vars = translateBinaryOp ">=" lhs rhs
18521866
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+
18531877 | (LPlus _) <- op
18541878 , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
18551879 | (LMinus _) <- op
@@ -1884,7 +1908,7 @@ translateExpression (SOp op vars)
18841908 , (arg:_) <- vars = JSPreOp "~" (JSVar arg)
18851909
18861910 | LStrConcat <- op
1887− , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1911+ , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
18881912 | LStrEq <- op
18891913 , (lhs:rhs:_) <- vars = translateBinaryOp "==" lhs rhs
18901914 | LStrLt <- op
@@ -1913,9 +1937,9 @@ translateExpression (SOp op vars)
19131937 | (LFloatInt ITNative) <- op
19141938 , (arg:_) <- vars = JSVar arg
19151939 | (LChInt ITNative) <- op
1916− , (arg:_) <- vars = JSProj (JSVar arg) "charCodeAt(0)"
1940+ , (arg:_) <- vars = jsCall "__IDRRT__charCode" [JSVar arg]
19171941 | (LIntCh ITNative) <- op
1918− , (arg:_) <- vars = jsCall "String.fromCharCode" [JSVar arg]
1942+ , (arg:_) <- vars = jsCall "__IDRRT__fromCharCode" [JSVar arg]
19191943
19201944 | LFExp <- op
19211945 , (arg:_) <- vars = jsCall "Math.exp" [JSVar arg]
@@ -1941,7 +1965,7 @@ translateExpression (SOp op vars)
19411965 , (arg:_) <- vars = jsCall "Math.ceil" [JSVar arg]
19421966
19431967 | LStrCons <- op
1944− , (lhs:rhs:_) <- vars = translateBinaryOp "+" lhs rhs
1968+ , (lhs:rhs:_) <- vars = invokeMeth lhs "concat" [rhs]
19451969 | LStrHead <- op
19461970 , (arg:_) <- vars = JSIndex (JSVar arg) (JSNum (JSInt 0))
19471971 | LStrRev <- op