@@ -2,6 +2,8 @@
22{-# LANGUAGE OverloadedStrings #-}
33module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where
44
5+import IRTS.JavaScript.AST
6+
57import Idris.AbsSyntax hiding (TypeCase)
68import IRTS.Bytecode
79import IRTS.Lang
@@ -82,290 +84,6 @@ initCompileInfo bc =
8284data JSTarget = Node | JavaScript deriving Eq
8385
8486
85−data JSType = JSIntTy
86− | JSStringTy
87− | JSIntegerTy
88− | JSFloatTy
89− | JSCharTy
90− | JSPtrTy
91− | JSForgotTy
92− deriving Eq
93−
94−
95−data JSInteger = JSBigZero
96− | JSBigOne
97− | JSBigInt Integer
98− | JSBigIntExpr JS
99− deriving Eq
100−
101−
102−data JSNum = JSInt Int
103− | JSFloat Double
104− | JSInteger JSInteger
105− deriving Eq
106−
107−
108−data JSWord = JSWord8 Word8
109− | JSWord16 Word16
110− | JSWord32 Word32
111− | JSWord64 Word64
112− deriving Eq
113−
114−
115−data JSAnnotation = JSConstructor deriving Eq
116−
117−
118−instance Show JSAnnotation where
119− show JSConstructor = "constructor"
120−
121−
122−data JS = JSRaw String
123− | JSIdent String
124− | JSFunction [String] JS
125− | JSType JSType
126− | JSSeq [JS]
127− | JSReturn JS
128− | JSApp JS [JS]
129− | JSNew String [JS]
130− | JSError String
131− | JSBinOp String JS JS
132− | JSPreOp String JS
133− | JSPostOp String JS
134− | JSProj JS String
135− | JSNull
136− | JSUndefined
137− | JSThis
138− | JSTrue
139− | JSFalse
140− | JSArray [JS]
141− | JSString String
142− | JSNum JSNum
143− | JSWord JSWord
144− | JSAssign JS JS
145− | JSAlloc String (Maybe JS)
146− | JSIndex JS JS
147− | JSSwitch JS [(JS, JS)] (Maybe JS)
148− | JSCond [(JS, JS)]
149− | JSTernary JS JS JS
150− | JSParens JS
151− | JSWhile JS JS
152− | JSFFI String [JS]
153− | JSAnnotation JSAnnotation JS
154− | JSNoop
155− deriving Eq
156−
157−
158−data FFI = FFICode Char | FFIArg Int | FFIError String
159−
160−ffi :: String -> [String] -> T.Text
161−ffi code args = let parsed = ffiParse code in
162− case ffiError parsed of
163− Just err -> error err
164− Nothing -> renderFFI parsed args
165− where
166− ffiParse :: String -> [FFI]
167− ffiParse "" = []
168− ffiParse ['%'] = [FFIError $ "FFI - Invalid positional argument"]
169− ffiParse ('%':'%':ss) = FFICode '%' : ffiParse ss
170− ffiParse ('%':s:ss)
171− | isDigit s =
172− FFIArg (read $ s : takeWhile isDigit ss) : ffiParse (dropWhile isDigit ss)
173− | otherwise =
174− [FFIError "FFI - Invalid positional argument"]
175− ffiParse (s:ss) = FFICode s : ffiParse ss
176−
177−
178− ffiError :: [FFI] -> Maybe String
179− ffiError [] = Nothing
180− ffiError ((FFIError s):xs) = Just s
181− ffiError (x:xs) = ffiError xs
182−
183−
184− renderFFI :: [FFI] -> [String] -> T.Text
185− renderFFI [] _ = ""
186− renderFFI (FFICode c : fs) args = c `T.cons` renderFFI fs args
187− renderFFI (FFIArg i : fs) args
188− | i < length args && i >= 0 = T.pack (args !! i) `T.append` renderFFI fs args
189− | otherwise = error "FFI - Argument index out of bounds"
190−
191−compileJS :: JS -> T.Text
192−compileJS = compileJS' 0
193−
194−compileJS' :: Int -> JS -> T.Text
195−compileJS' indent JSNoop = ""
196−
197−compileJS' indent (JSAnnotation annotation js) =
198− "/** @" `T.append` T.pack (show annotation) `T.append` " */\n" `T.append` compileJS' indent js
199−
200−compileJS' indent (JSFFI raw args) =
201− ffi raw (map (T.unpack . compileJS' indent) args)
202−
203−compileJS' indent (JSRaw code) =
204− T.pack code
205−
206−compileJS' indent (JSIdent ident) =
207− T.pack ident
208−
209−compileJS' indent (JSFunction args body) =
210− T.replicate indent " " `T.append` "function("
211− `T.append` T.intercalate "," (map T.pack args)
212− `T.append` "){\n"
213− `T.append` compileJS' (indent + 2) body
214− `T.append` "\n}\n"
215−
216−compileJS' indent (JSType ty)
217− | JSIntTy <- ty = "i$Int"
218− | JSStringTy <- ty = "i$String"
219− | JSIntegerTy <- ty = "i$Integer"
220− | JSFloatTy <- ty = "i$Float"
221− | JSCharTy <- ty = "i$Char"
222− | JSPtrTy <- ty = "i$Ptr"
223− | JSForgotTy <- ty = "i$Forgot"
224−
225−compileJS' indent (JSSeq seq) =
226− T.intercalate ";\n" (
227− map (
228− (T.replicate indent " " `T.append`) . (compileJS' indent)
229− ) $ filter (/= JSNoop) seq
230− ) `T.append` ";"
231−
232−compileJS' indent (JSReturn val) =
233− "return " `T.append` compileJS' indent val
234−
235−compileJS' indent (JSApp lhs rhs)
236− | JSFunction {} <- lhs =
237− T.concat ["(", compileJS' indent lhs, ")(", args, ")"]
238− | otherwise =
239− T.concat [compileJS' indent lhs, "(", args, ")"]
240− where args :: T.Text
241− args = T.intercalate "," $ map (compileJS' 0) rhs
242−
243−compileJS' indent (JSNew name args) =
244− "new " `T.append` T.pack name `T.append` "(" `T.append` T.intercalate "," (map (compileJS' 0) args) `T.append` ")"
245−
246−compileJS' indent (JSError exc) =
247− "throw new Error(\"" `T.append` T.pack exc `T.append` "\")"
248−
249−compileJS' indent (JSBinOp op lhs rhs) =
250− compileJS' indent lhs `T.append` " " `T.append` T.pack op `T.append` " " `T.append` compileJS' indent rhs
251−
252−compileJS' indent (JSPreOp op val) =
253− T.pack op `T.append` compileJS' indent val
254−
255−compileJS' indent (JSProj obj field)
256− | JSFunction {} <- obj =
257− T.concat ["(", compileJS' indent obj, ").", T.pack field]
258− | JSAssign {} <- obj =
259− T.concat ["(", compileJS' indent obj, ").", T.pack field]
260− | otherwise =
261− compileJS' indent obj `T.append` ('.' `T.cons` T.pack field)
262−
263−compileJS' indent JSNull =
264− "null"
265−
266−compileJS' indent JSUndefined =
267− "undefined"
268−
269−compileJS' indent JSThis =
270− "this"
271−
272−compileJS' indent JSTrue =
273− "true"
274−
275−compileJS' indent JSFalse =
276− "false"
277−
278−compileJS' indent (JSArray elems) =
279− "[" `T.append` T.intercalate "," (map (compileJS' 0) elems) `T.append` "]"
280−
281−compileJS' indent (JSString str) =
282− "\"" `T.append` T.pack str `T.append` "\""
283−
284−compileJS' indent (JSNum num)
285− | JSInt i <- num = T.pack (show i)
286− | JSFloat f <- num = T.pack (show f)
287− | JSInteger JSBigZero <- num = T.pack "i$ZERO"
288− | JSInteger JSBigOne <- num = T.pack "i$ONE"
289− | JSInteger (JSBigInt i) <- num = T.pack (show i)
290− | JSInteger (JSBigIntExpr e) <- num = "i$bigInt(" `T.append` compileJS' indent e `T.append` ")"
291−
292−compileJS' indent (JSAssign lhs rhs) =
293− compileJS' indent lhs `T.append` " = " `T.append` compileJS' indent rhs
294−
295−compileJS' 0 (JSAlloc name (Just val@(JSNew _ _))) =
296− "var " `T.append` T.pack name `T.append` " = " `T.append` compileJS' 0 val `T.append` ";\n"
297−
298−compileJS' indent (JSAlloc name val) =
299− "var " `T.append` T.pack name `T.append` maybe "" ((" = " `T.append`) . compileJS' indent) val
300−
301−compileJS' indent (JSIndex lhs rhs) =
302− compileJS' indent lhs `T.append` "[" `T.append` compileJS' indent rhs `T.append` "]"
303−
304−compileJS' indent (JSCond branches) =
305− T.intercalate " else " $ map createIfBlock branches
306− where
307− createIfBlock (JSNoop, e@(JSSeq _)) =
308− "{\n"
309− `T.append` compileJS' (indent + 2) e
310− `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
311− createIfBlock (JSNoop, e) =
312− "{\n"
313− `T.append` compileJS' (indent + 2) e
314− `T.append` ";\n" `T.append` T.replicate indent " " `T.append` "}"
315− createIfBlock (cond, e@(JSSeq _)) =
316− "if (" `T.append` compileJS' indent cond `T.append`") {\n"
317− `T.append` compileJS' (indent + 2) e
318− `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
319− createIfBlock (cond, e) =
320− "if (" `T.append` compileJS' indent cond `T.append`") {\n"
321− `T.append` T.replicate (indent + 2) " " `T.append` compileJS' (indent + 2) e
322− `T.append` ";\n" `T.append` T.replicate indent " " `T.append` "}"
323−
324−compileJS' indent (JSSwitch val [(_,JSSeq seq)] Nothing) =
325− let (h,t) = splitAt 1 seq in
326− (T.concat (map (compileJS' indent) h) `T.append` ";\n")
327− `T.append` (T.intercalate ";\n" $ map ((T.replicate indent " " `T.append`) . compileJS' indent) t)
328−
329−compileJS' indent (JSSwitch val branches def) =
330− "switch(" `T.append` compileJS' indent val `T.append` "){\n"
331− `T.append` T.concat (map mkBranch branches)
332− `T.append` mkDefault def
333− `T.append` T.replicate indent " " `T.append` "}"
334− where
335− mkBranch :: (JS, JS) -> T.Text
336− mkBranch (tag, code) =
337− T.replicate (indent + 2) " " `T.append` "case " `T.append` compileJS' indent tag `T.append` ":\n"
338− `T.append` compileJS' (indent + 4) code
339− `T.append` "\n" `T.append` (T.replicate (indent + 4) " " `T.append` "break;\n")
340−
341− mkDefault :: Maybe JS -> T.Text
342− mkDefault Nothing = ""
343− mkDefault (Just def) =
344− T.replicate (indent + 2) " " `T.append` "default:\n"
345− `T.append` compileJS' (indent + 4)def
346− `T.append` "\n"
347−
348−
349−compileJS' indent (JSTernary cond true false) =
350− let c = compileJS' indent cond
351− t = compileJS' indent true
352− f = compileJS' indent false in
353− "(" `T.append` c `T.append` ")?(" `T.append` t `T.append` "):(" `T.append` f `T.append` ")"
354−
355−compileJS' indent (JSParens js) =
356− "(" `T.append` compileJS' indent js `T.append` ")"
357−
358−compileJS' indent (JSWhile cond body) =
359− "while (" `T.append` compileJS' indent cond `T.append` ") {\n"
360− `T.append` compileJS' (indent + 2) body
361− `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
362−
363−compileJS' indent (JSWord word)
364− | JSWord8 b <- word = "new Uint8Array([" `T.append` T.pack (show b) `T.append` "])"
365− | JSWord16 b <- word = "new Uint16Array([" `T.append` T.pack (show b) `T.append` "])"
366− | JSWord32 b <- word = "new Uint32Array([" `T.append` T.pack (show b) `T.append` "])"
367− | JSWord64 b <- word = "i$bigInt(\"" `T.append` T.pack (show b) `T.append` "\")"
368−
36987codegenJavaScript :: CodeGenerator
37088codegenJavaScript ci =
37189 codegenJS_all JavaScript (simpleDecls ci)
@@ -893,64 +611,6 @@ jsMKCON info r t rs =
893611 ]
894612 )
895613
896−jsInstanceOf :: JS -> String -> JS
897−jsInstanceOf obj cls = JSBinOp "instanceof" obj (JSIdent cls)
898−
899−jsOr :: JS -> JS -> JS
900−jsOr lhs rhs = JSBinOp "||" lhs rhs
901−
902−jsAnd :: JS -> JS -> JS
903−jsAnd lhs rhs = JSBinOp "&&" lhs rhs
904−
905−jsMeth :: JS -> String -> [JS] -> JS
906−jsMeth obj meth args = JSApp (JSProj obj meth) args
907−
908−jsCall :: String -> [JS] -> JS
909−jsCall fun args = JSApp (JSIdent fun) args
910−
911−jsTypeOf :: JS -> JS
912−jsTypeOf js = JSPreOp "typeof " js
913−
914−jsEq :: JS -> JS -> JS
915−jsEq lhs@(JSNum (JSInteger _)) rhs = JSApp (JSProj lhs "equals") [rhs]
916−jsEq lhs rhs@(JSNum (JSInteger _)) = JSApp (JSProj lhs "equals") [rhs]
917−jsEq lhs rhs = JSBinOp "==" lhs rhs
918−
919−jsNotEq :: JS -> JS -> JS
920−jsNotEq lhs rhs = JSBinOp "!=" lhs rhs
921−
922−jsIsNumber :: JS -> JS
923−jsIsNumber js = (jsTypeOf js) `jsEq` (JSString "number")
924−
925−jsIsNull :: JS -> JS
926−jsIsNull js = JSBinOp "==" js JSNull
927−
928−jsBigInt :: JS -> JS
929−jsBigInt (JSString "0") = JSNum (JSInteger JSBigZero)
930−jsBigInt (JSString "1") = JSNum (JSInteger JSBigOne)
931−jsBigInt js = JSNum $ JSInteger $ JSBigIntExpr js
932−
933−jsUnPackBits :: JS -> JS
934−jsUnPackBits js = JSIndex js $ JSNum (JSInt 0)
935−
936−jsPackUBits8 :: JS -> JS
937−jsPackUBits8 js = JSNew "Uint8Array" [JSArray [js]]
938−
939−jsPackUBits16 :: JS -> JS
940−jsPackUBits16 js = JSNew "Uint16Array" [JSArray [js]]
941−
942−jsPackUBits32 :: JS -> JS
943−jsPackUBits32 js = JSNew "Uint32Array" [JSArray [js]]
944−
945−jsPackSBits8 :: JS -> JS
946−jsPackSBits8 js = JSNew "Int8Array" [JSArray [js]]
947−
948−jsPackSBits16 :: JS -> JS
949−jsPackSBits16 js = JSNew "Int16Array" [JSArray [js]]
950−
951−jsPackSBits32 :: JS -> JS
952−jsPackSBits32 js = JSNew "Int32Array" [JSArray [js]]
953−
954614jsCASE :: CompileInfo -> Bool -> Reg -> [(Int, [BC])] -> Maybe [BC] -> JS
955615jsCASE info safe reg cases def =
956616 JSSwitch (tag safe $ translateReg reg) (