@@ -1,4 +1,5 @@
11{-# LANGUAGE PatternGuards #-}
2+{-# LANGUAGE OverloadedStrings #-}
23module IRTS.CodegenJavaScript (codegenJavaScript, codegenNode, JSTarget(..)) where
34
45import Idris.AbsSyntax hiding (TypeCase)
@@ -25,6 +26,8 @@ import System.IO
2526import System.Directory
2627
2728import qualified Data.Map.Strict as M
29+import qualified Data.Text as T
30+import qualified Data.Text.IO as TIO
2831
2932
3033data CompileInfo = CompileInfo { compileInfoApplyCases :: [Int]
@@ -154,7 +157,7 @@ data JS = JSRaw String
154157
155158data FFI = FFICode Char | FFIArg Int | FFIError String
156159
157−ffi :: String -> [String] -> String
160+ffi :: String -> [String] -> T.Text
158161ffi code args = let parsed = ffiParse code in
159162 case ffiError parsed of
160163 Just err -> error err
@@ -178,37 +181,37 @@ ffi code args = let parsed = ffiParse code in
178181 ffiError (x:xs) = ffiError xs
179182
180183
181− renderFFI :: [FFI] -> [String] -> String
184+ renderFFI :: [FFI] -> [String] -> T.Text
182185 renderFFI [] _ = ""
183− renderFFI (FFICode c : fs) args = c : renderFFI fs args
186+ renderFFI (FFICode c : fs) args = c `T.cons` renderFFI fs args
184187 renderFFI (FFIArg i : fs) args
185− | i < length args && i >= 0 = args !! i ++ renderFFI fs args
188+ | i < length args && i >= 0 = T.pack (args !! i) `T.append` renderFFI fs args
186189 | otherwise = error "FFI - Argument index out of bounds"
187190
188−compileJS :: JS -> String
191+compileJS :: JS -> T.Text
189192compileJS = compileJS' 0
190193
191−compileJS' :: Int -> JS -> String
194+compileJS' :: Int -> JS -> T.Text
192195compileJS' indent JSNoop = ""
193196
194197compileJS' indent (JSAnnotation annotation js) =
195− "/** @" ++ show annotation ++ " */\n" ++ compileJS' indent js
198+ "/** @" `T.append` T.pack (show annotation) `T.append` " */\n" `T.append` compileJS' indent js
196199
197200compileJS' indent (JSFFI raw args) =
198− ffi raw (map (compileJS' indent) args)
201+ ffi raw (map (T.unpack . compileJS' indent) args)
199202
200203compileJS' indent (JSRaw code) =
201− code
204+ T.pack code
202205
203206compileJS' indent (JSIdent ident) =
204− ident
207+ T.pack ident
205208
206209compileJS' indent (JSFunction args body) =
207− replicate indent ' ' ++ "function("
208− ++ intercalate "," args
209− ++ "){\n"
210− ++ compileJS' (indent + 2) body
211− ++ "\n}\n"
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"
212215
213216compileJS' indent (JSType ty)
214217 | JSIntTy <- ty = "i$Int"
@@ -220,42 +223,42 @@ compileJS' indent (JSType ty)
220223 | JSForgotTy <- ty = "i$Forgot"
221224
222225compileJS' indent (JSSeq seq) =
223− intercalate ";\n" (
226+ T.intercalate ";\n" (
224227 map (
225− (replicate indent ' ' ++) . (compileJS' indent)
228+ (T.replicate indent " " `T.append`) . (compileJS' indent)
226229 ) $ filter (/= JSNoop) seq
227− ) ++ ";"
230+ ) `T.append` ";"
228231
229232compileJS' indent (JSReturn val) =
230− "return " ++ compileJS' indent val
233+ "return " `T.append` compileJS' indent val
231234
232235compileJS' indent (JSApp lhs rhs)
233236 | JSFunction {} <- lhs =
234− concat ["(", compileJS' indent lhs, ")(", args, ")"]
237+ T.concat ["(", compileJS' indent lhs, ")(", args, ")"]
235238 | otherwise =
236− concat [compileJS' indent lhs, "(", args, ")"]
237− where args :: String
238− args = intercalate "," $ map (compileJS' 0) rhs
239+ T.concat [compileJS' indent lhs, "(", args, ")"]
240+ where args :: T.Text
241+ args = T.intercalate "," $ map (compileJS' 0) rhs
239242
240243compileJS' indent (JSNew name args) =
241− "new " ++ name ++ "(" ++ intercalate "," (map (compileJS' 0) args) ++ ")"
244+ "new " `T.append` T.pack name `T.append` "(" `T.append` T.intercalate "," (map (compileJS' 0) args) `T.append` ")"
242245
243246compileJS' indent (JSError exc) =
244− "throw new Error(\"" ++ exc ++ "\")"
247+ "throw new Error(\"" `T.append` T.pack exc `T.append` "\")"
245248
246249compileJS' indent (JSBinOp op lhs rhs) =
247− compileJS' indent lhs ++ " " ++ op ++ " " ++ compileJS' indent rhs
250+ compileJS' indent lhs `T.append` " " `T.append` T.pack op `T.append` " " `T.append` compileJS' indent rhs
248251
249252compileJS' indent (JSPreOp op val) =
250− op ++ compileJS' indent val
253+ T.pack op `T.append` compileJS' indent val
251254
252255compileJS' indent (JSProj obj field)
253256 | JSFunction {} <- obj =
254− concat ["(", compileJS' indent obj, ").", field]
257+ T.concat ["(", compileJS' indent obj, ").", T.pack field]
255258 | JSAssign {} <- obj =
256− concat ["(", compileJS' indent obj, ").", field]
259+ T.concat ["(", compileJS' indent obj, ").", T.pack field]
257260 | otherwise =
258− compileJS' indent obj ++ '.' : field
261+ compileJS' indent obj `T.append` ('.' `T.cons` T.pack field)
259262
260263compileJS' indent JSNull =
261264 "null"
@@ -273,95 +276,95 @@ compileJS' indent JSFalse =
273276 "false"
274277
275278compileJS' indent (JSArray elems) =
276− "[" ++ intercalate "," (map (compileJS' 0) elems) ++ "]"
279+ "[" `T.append` T.intercalate "," (map (compileJS' 0) elems) `T.append` "]"
277280
278281compileJS' indent (JSString str) =
279− "\"" ++ str ++ "\""
282+ "\"" `T.append` T.pack str `T.append` "\""
280283
281284compileJS' indent (JSNum num)
282− | JSInt i <- num = show i
283− | JSFloat f <- num = show f
284− | JSInteger JSBigZero <- num = "i$ZERO"
285− | JSInteger JSBigOne <- num = "i$ONE"
286− | JSInteger (JSBigInt i) <- num = show i
287− | JSInteger (JSBigIntExpr e) <- num = "i$bigInt(" ++ compileJS' indent e ++ ")"
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` ")"
288291
289292compileJS' indent (JSAssign lhs rhs) =
290− compileJS' indent lhs ++ " = " ++ compileJS' indent rhs
293+ compileJS' indent lhs `T.append` " = " `T.append` compileJS' indent rhs
291294
292295compileJS' 0 (JSAlloc name (Just val@(JSNew _ _))) =
293− "var " ++ name ++ " = " ++ compileJS' 0 val ++ ";\n"
296+ "var " `T.append` T.pack name `T.append` " = " `T.append` compileJS' 0 val `T.append` ";\n"
294297
295298compileJS' indent (JSAlloc name val) =
296− "var " ++ name ++ maybe "" ((" = " ++) . compileJS' indent) val
299+ "var " `T.append` T.pack name `T.append` maybe "" ((" = " `T.append`) . compileJS' indent) val
297300
298301compileJS' indent (JSIndex lhs rhs) =
299− compileJS' indent lhs ++ "[" ++ compileJS' indent rhs ++ "]"
302+ compileJS' indent lhs `T.append` "[" `T.append` compileJS' indent rhs `T.append` "]"
300303
301304compileJS' indent (JSCond branches) =
302− intercalate " else " $ map createIfBlock branches
305+ T.intercalate " else " $ map createIfBlock branches
303306 where
304307 createIfBlock (JSNoop, e@(JSSeq _)) =
305308 "{\n"
306− ++ compileJS' (indent + 2) e
307− ++ "\n" ++ replicate indent ' ' ++ "}"
309+ `T.append` compileJS' (indent + 2) e
310+ `T.append` "\n" `T.append` T.replicate indent " " `T.append` "}"
308311 createIfBlock (JSNoop, e) =
309312 "{\n"
310− ++ compileJS' (indent + 2) e
311− ++ ";\n" ++ replicate indent ' ' ++ "}"
313+ `T.append` compileJS' (indent + 2) e
314+ `T.append` ";\n" `T.append` T.replicate indent " " `T.append` "}"
312315 createIfBlock (cond, e@(JSSeq _)) =
313− "if (" ++ compileJS' indent cond ++") {\n"
314− ++ compileJS' (indent + 2) e
315− ++ "\n" ++ replicate indent ' ' ++ "}"
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` "}"
316319 createIfBlock (cond, e) =
317− "if (" ++ compileJS' indent cond ++") {\n"
318− ++ replicate (indent + 2) ' ' ++ compileJS' (indent + 2) e
319− ++ ";\n" ++ replicate indent ' ' ++ "}"
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` "}"
320323
321324compileJS' indent (JSSwitch val [(_,JSSeq seq)] Nothing) =
322325 let (h,t) = splitAt 1 seq in
323− (concatMap (compileJS' indent) h ++ ";\n")
324− ++ (intercalate ";\n" $ map ((replicate indent ' ' ++) . compileJS' indent) t)
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)
325328
326329compileJS' indent (JSSwitch val branches def) =
327− "switch(" ++ compileJS' indent val ++ "){\n"
328− ++ concatMap mkBranch branches
329− ++ mkDefault def
330− ++ replicate indent ' ' ++ "}"
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` "}"
331334 where
332− mkBranch :: (JS, JS) -> String
335+ mkBranch :: (JS, JS) -> T.Text
333336 mkBranch (tag, code) =
334− replicate (indent + 2) ' ' ++ "case " ++ compileJS' indent tag ++ ":\n"
335− ++ compileJS' (indent + 4) code
336− ++ "\n" ++ (replicate (indent + 4) ' ' ++ "break;\n")
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")
337340
338− mkDefault :: Maybe JS -> String
341+ mkDefault :: Maybe JS -> T.Text
339342 mkDefault Nothing = ""
340343 mkDefault (Just def) =
341− replicate (indent + 2) ' ' ++ "default:\n"
342− ++ compileJS' (indent + 4)def
343− ++ "\n"
344+ T.replicate (indent + 2) " " `T.append` "default:\n"
345+ `T.append` compileJS' (indent + 4)def
346+ `T.append` "\n"
344347
345348
346349compileJS' indent (JSTernary cond true false) =
347350 let c = compileJS' indent cond
348351 t = compileJS' indent true
349352 f = compileJS' indent false in
350− "(" ++ c ++ ")?(" ++ t ++ "):(" ++ f ++ ")"
353+ "(" `T.append` c `T.append` ")?(" `T.append` t `T.append` "):(" `T.append` f `T.append` ")"
351354
352355compileJS' indent (JSParens js) =
353− "(" ++ compileJS' indent js ++ ")"
356+ "(" `T.append` compileJS' indent js `T.append` ")"
354357
355358compileJS' indent (JSWhile cond body) =
356− "while (" ++ compileJS' indent cond ++ ") {\n"
357− ++ compileJS' (indent + 2) body
358− ++ "\n" ++ replicate indent ' ' ++ "}"
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` "}"
359362
360363compileJS' indent (JSWord word)
361− | JSWord8 b <- word = "new Uint8Array([" ++ show b ++ "])"
362− | JSWord16 b <- word = "new Uint16Array([" ++ show b ++ "])"
363− | JSWord32 b <- word = "new Uint32Array([" ++ show b ++ "])"
364− | JSWord64 b <- word = "i$bigInt(\"" ++ show b ++ "\")"
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` "\")"
365368
366369codegenJavaScript :: CodeGenerator
367370codegenJavaScript ci =
@@ -406,12 +409,12 @@ codegenJS_all target definitions includes libs filename outputType = do
406409 ++ idrRuntime
407410 ++ tgtRuntime
408411 )
409− writeFile filename ( runtime
410− ++ concatMap compileJS opt
411− ++ concatMap compileJS cons
412− ++ main
413− ++ invokeMain
414− )
412+ TIO.writeFile filename ( T.pack runtime
413+ `T.append` T.concat (map compileJS opt)
414+ `T.append` T.concat (map compileJS cons)
415+ `T.append` main
416+ `T.append` invokeMain
417+ )
415418 setPermissions filename (emptyPermissions { readable = True
416419 , executable = target == Node
417420 , writable = True
@@ -478,7 +481,7 @@ codegenJS_all target definitions includes libs filename outputType = do
478481 getIncludes :: [FilePath] -> IO [String]
479482 getIncludes = mapM readFile
480483
481− main :: String
484+ main :: T.Text
482485 main =
483486 compileJS $ JSAlloc "main" (Just $
484487 JSFunction [] (
@@ -532,7 +535,7 @@ codegenJS_all target definitions includes libs filename outputType = do
532535 )
533536 ]
534537
535− invokeMain :: String
538+ invokeMain :: T.Text
536539 invokeMain = compileJS $ JSApp (JSIdent "main") []
537540
538541optimizeConstructors :: [JS] -> ([JS], [JS])