@@ -267,9 +267,9 @@ compileJS (JSWhile cond body) =
267267 ++ "\n}"
268268
269269compileJS (JSWord word)
270− | JSWord8 b <- word = show b
271− | JSWord16 b <- word = show b
272− | JSWord32 b <- word = show b
270+ | JSWord8 b <- word = "new Uint8Array([" ++ show b ++ "])"
271+ | JSWord16 b <- word = "new Uint16Array([" ++ show b ++ "])"
272+ | JSWord32 b <- word = "new Uint32Array([" ++ show b ++ "])"
273273 | JSWord64 b <- word = idrRTNamespace ++ "bigInt(\"" ++ show b ++ "\")"
274274
275275
@@ -343,6 +343,19 @@ jsLet name value body =
343343jsError :: String -> JS
344344jsError err = JSApp (JSFunction [] (JSError err)) []
345345
346+jsUnPackBits :: JS -> JS
347+jsUnPackBits js = JSIndex js $ JSNum (JSInt 0)
348+
349+
350+jsPackBits8 :: JS -> JS
351+jsPackBits8 js = JSNew "Uint8Array" [JSArray [js]]
352+
353+jsPackBits16 :: JS -> JS
354+jsPackBits16 js = JSNew "Uint16Array" [JSArray [js]]
355+
356+jsPackBits32 :: JS -> JS
357+jsPackBits32 js = JSNew "Uint32Array" [JSArray [js]]
358+
346359
347360foldJS :: (JS -> a) -> (a -> a -> a) -> a -> JS -> a
348361foldJS tr add acc js =
@@ -1830,16 +1843,25 @@ translateExpression (SApp tc name vars)
18301843translateExpression (SOp op vars)
18311844 | LNoOp <- op = JSVar (last vars)
18321845
1833− | (LZExt (ITFixed IT8) ITNative) <- op = JSVar (last vars)
1846+ | (LZExt (ITFixed IT8) ITNative) <- op = jsUnPackBits $ JSVar (last vars)
18341847
18351848 | (LLSHR (ITFixed IT8)) <- op
1836− , (lhs:rhs:_) <- vars = translateBinaryOp ">>" lhs rhs
1849+ , (lhs:rhs:_) <- vars =
1850+ jsPackBits8 (
1851+ JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)
1852+ )
18371853
18381854 | (LLSHR (ITFixed IT16)) <- op
1839− , (lhs:rhs:_) <- vars = translateBinaryOp ">>" lhs rhs
1855+ , (lhs:rhs:_) <- vars =
1856+ jsPackBits16 (
1857+ JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)
1858+ )
18401859
18411860 | (LLSHR (ITFixed IT32)) <- op
1842− , (lhs:rhs:_) <- vars = translateBinaryOp ">>" lhs rhs
1861+ , (lhs:rhs:_) <- vars =
1862+ jsPackBits32 (
1863+ JSBinOp ">>" (jsUnPackBits $ JSVar lhs) (jsUnPackBits $ JSVar rhs)
1864+ )
18431865
18441866 | (LLSHR (ITFixed IT64)) <- op
18451867 , (lhs:rhs:_) <- vars =
@@ -1898,24 +1920,48 @@ translateExpression (SOp op vars)
18981920
18991921 | (LTrunc (ITFixed IT16) (ITFixed IT8)) <- op
19001922 , (arg:_) <- vars =
1901− JSParens $ JSBinOp "&" (JSVar arg) (JSNum (JSInt 0xFF))
1923+ jsPackBits8 (
1924+ JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFF))
1925+ )
19021926
19031927 | (LTrunc (ITFixed IT32) (ITFixed IT16)) <- op
19041928 , (arg:_) <- vars =
1905− JSParens $ JSBinOp "&" (JSVar arg) (JSNum (JSInt 0xFFFF))
1929+ jsPackBits16 (
1930+ JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFFFF))
1931+ )
19061932
19071933 | (LTrunc (ITFixed IT64) (ITFixed IT32)) <- op
19081934 , (arg:_) <- vars =
1909− jsMeth (jsMeth (JSVar arg) "and" [
1910− jsBigInt (JSString $ show 0xFFFFFFFF)
1911− ]) "intValue" []
1935+ jsPackBits32 (
1936+ jsMeth (jsMeth (JSVar arg) "and" [
1937+ jsBigInt (JSString $ show 0xFFFFFFFF)
1938+ ]) "intValue" []
1939+ )
19121940
19131941 | (LTrunc ITBig (ITFixed IT64)) <- op
19141942 , (arg:_) <- vars =
19151943 jsMeth (JSVar arg) "and" [
1916− jsBigInt (JSString $ show 0xFFFFFFFF)
1944+ jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)
19171945 ]
19181946
1947+ | (LAnd (ITFixed IT8)) <- op
1948+ , (lhs:rhs:_) <- vars =
1949+ jsPackBits8 (
1950+ JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
1951+ )
1952+
1953+ | (LAnd (ITFixed IT16)) <- op
1954+ , (lhs:rhs:_) <- vars =
1955+ jsPackBits16 (
1956+ JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
1957+ )
1958+
1959+ | (LAnd (ITFixed IT32)) <- op
1960+ , (lhs:rhs:_) <- vars =
1961+ jsPackBits32 (
1962+ JSBinOp "&" (jsUnPackBits (JSVar lhs)) (jsUnPackBits (JSVar rhs))
1963+ )
1964+
19191965 | (LAnd (ITFixed IT64)) <- op
19201966 , (lhs:rhs:_) <- vars =
19211967 jsMeth (JSVar lhs) "and" [JSVar rhs]