26d7d2b · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

javascript: switch Bits support to UintArrays

26d7d2braichoo13 years ago

src/IRTS/CodegenJavaScript.hs+59−13

compare with master

unifiedsplit

@@ -267,9 +267,9 @@ compileJS (JSWhile cond body) =

267 ++ "\n}"

268

269compileJS (JSWord word)

270− | JSWord8 b <- word = show b

270+ | JSWord8 b <- word = "new Uint8Array([" ++ show b ++ "])"

271− | JSWord16 b <- word = show b

271+ | JSWord16 b <- word = "new Uint16Array([" ++ show b ++ "])"

272− | JSWord32 b <- word = show b

272+ | JSWord32 b <- word = "new Uint32Array([" ++ show b ++ "])"

273 | JSWord64 b <- word = idrRTNamespace ++ "bigInt(\"" ++ show b ++ "\")"

274

275

@@ -343,6 +343,19 @@ jsLet name value body =

343jsError :: String -> JS

344jsError err = JSApp (JSFunction [] (JSError err)) []

345

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+

346

359

347foldJS :: (JS -> a) -> (a -> a -> a) -> a -> JS -> a

360foldJS :: (JS -> a) -> (a -> a -> a) -> a -> JS -> a

348foldJS tr add acc js =

361foldJS tr add acc js =

@@ -1830,16 +1843,25 @@ translateExpression (SApp tc name vars)

1830translateExpression (SOp op vars)

1843translateExpression (SOp op vars)

1831 | LNoOp <- op = JSVar (last vars)

1844 | LNoOp <- op = JSVar (last vars)

1832

1845

1833− | (LZExt (ITFixed IT8) ITNative) <- op = JSVar (last vars)

1846+ | (LZExt (ITFixed IT8) ITNative) <- op = jsUnPackBits $ JSVar (last vars)

1834

1847

1835 | (LLSHR (ITFixed IT8)) <- op

1848 | (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+ )

1837

1853

1838 | (LLSHR (ITFixed IT16)) <- op

1854 | (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+ )

1840

1859

1841 | (LLSHR (ITFixed IT32)) <- op

1860 | (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+ )

1843

1865

1844 | (LLSHR (ITFixed IT64)) <- op

1866 | (LLSHR (ITFixed IT64)) <- op

1845 , (lhs:rhs:_) <- vars =

1867 , (lhs:rhs:_) <- vars =

@@ -1898,24 +1920,48 @@ translateExpression (SOp op vars)

1898

1920

1899 | (LTrunc (ITFixed IT16) (ITFixed IT8)) <- op

1921 | (LTrunc (ITFixed IT16) (ITFixed IT8)) <- op

1900 , (arg:_) <- vars =

1922 , (arg:_) <- vars =

1923+ jsPackBits8 (

1901− JSParens $ JSBinOp "&" (JSVar arg) (JSNum (JSInt 0xFF))

1924+ JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFF))

1925+ )

1902

1926

1903 | (LTrunc (ITFixed IT32) (ITFixed IT16)) <- op

1927 | (LTrunc (ITFixed IT32) (ITFixed IT16)) <- op

1904 , (arg:_) <- vars =

1928 , (arg:_) <- vars =

1929+ jsPackBits16 (

1905− JSParens $ JSBinOp "&" (JSVar arg) (JSNum (JSInt 0xFFFF))

1930+ JSBinOp "&" (jsUnPackBits $ JSVar arg) (JSNum (JSInt 0xFFFF))

1931+ )

1906

1932

1907 | (LTrunc (ITFixed IT64) (ITFixed IT32)) <- op

1933 | (LTrunc (ITFixed IT64) (ITFixed IT32)) <- op

1908 , (arg:_) <- vars =

1934 , (arg:_) <- vars =

1935+ jsPackBits32 (

1909− jsMeth (jsMeth (JSVar arg) "and" [

1936+ jsMeth (jsMeth (JSVar arg) "and" [

1910− jsBigInt (JSString $ show 0xFFFFFFFF)

1937+ jsBigInt (JSString $ show 0xFFFFFFFF)

1911− ]) "intValue" []

1938+ ]) "intValue" []

1939+ )

1912

1940

1913 | (LTrunc ITBig (ITFixed IT64)) <- op

1941 | (LTrunc ITBig (ITFixed IT64)) <- op

1914 , (arg:_) <- vars =

1942 , (arg:_) <- vars =

1915 jsMeth (JSVar arg) "and" [

1943 jsMeth (JSVar arg) "and" [

1916− jsBigInt (JSString $ show 0xFFFFFFFF)

1944+ jsBigInt (JSString $ show 0xFFFFFFFFFFFFFFFF)

1917 ]

1945 ]

1918

1946

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+

1919 | (LAnd (ITFixed IT64)) <- op

1965 | (LAnd (ITFixed IT64)) <- op

1920 , (lhs:rhs:_) <- vars =

1966 , (lhs:rhs:_) <- vars =

1921 jsMeth (JSVar lhs) "and" [JSVar rhs]

1967 jsMeth (JSVar lhs) "and" [JSVar rhs]