git.iko.soy/Idris-dev
on master help sign in
javascript: add browser runtime
eeec833raichoo
src/IRTS/CodegenJavaScript.hs+60−26
compare with master
unifiedsplit
@@ -358,10 +358,9 @@ codegenJS_all target definitions includes filename outputType = do
358 let js = concatMap (translateDecl info) bytecode
358 let js = concatMap (translateDecl info) bytecode
359 let code = concatMap ((map compileJS) . collectSplitFunctions . (\x -> evalRWS (splitFunction x) () 0)) js
359 let code = concatMap ((map compileJS) . collectSplitFunctions . (\x -> evalRWS (splitFunction x) () 0)) js
360 let (header, rt) = case target of
360 let (header, rt) = case target of
361− Node ->
362− ("#!/usr/bin/env node\n", "-node")
361+ Node -> ("#!/usr/bin/env node\n", "-node")
363− JavaScript ->
362+ JavaScript -> ("", "-browser")
364− ("", "-browser")
363+
365 included <- concat <$> getIncludes includes
364 included <- concat <$> getIncludes includes
366 path <- (++) <$> getDataDir <*> (pure "/jsrts/")
365 path <- (++) <$> getDataDir <*> (pure "/jsrts/")
367 idrRuntime <- readFile $ path ++ "Runtime-common.js"
366 idrRuntime <- readFile $ path ++ "Runtime-common.js"
@@ -378,22 +377,59 @@ codegenJS_all target definitions includes filename outputType = do
378 getIncludes = mapM readFile
377 getIncludes = mapM readFile
379
378
380 main :: String
379 main :: String
381− main = compileJS $
380+ main =
382− JSAlloc "main" $ Just $ JSFunction [] (
381+ compileJS $ JSAlloc "main" (Just $
383− JSSeq [ JSAlloc "vm" (Just $ JSNew "i$VM" [])
382+ JSFunction [] (
384− , JSApp (JSIdent "i$SCHED") [JSIdent "vm"]
383+ case target of
385− , JSApp (
384+ Node -> mainFun
386− JSIdent (translateName (sMN 0 "runMain"))
385+ JavaScript -> jsMain
387− ) [JSNum (JSInt 0)]
386+ )
388− , JSWhile (JSProj jsCALLSTACK "length") (
389− JSSeq [ JSAlloc "func" (Just jsPOP)
390− , JSAlloc "args" (Just jsPOP)
391− , JSApp (JSProj (JSIdent "func") "apply") [JSThis, JSIdent "args"]
392− ]
393− )
394− ]
395 )
387 )
396
388
389+ jsMain :: JS
390+ jsMain =
391+ JSCond [ (exists document `jsAnd` isReady, mainFun)
392+ , (exists window, windowMainFun)
393+ , (JSTrue, mainFun)
394+ ]
395+ where
396+ exists :: JS -> JS
397+ exists js = jsTypeOf js `jsNotEq` JSString "undefined"
398+
399+ window :: JS
400+ window = JSIdent "window"
401+
402+ document :: JS
403+ document = JSIdent "document"
404+
405+ windowMainFun :: JS
406+ windowMainFun =
407+ jsMeth window "addEventListener" [ JSString "DOMContentLoaded"
408+ , JSFunction [] ( mainFun )
409+ , JSFalse
410+ ]
411+
412+ isReady :: JS
413+ isReady = JSParens $ readyState `jsEq` JSString "complete" `jsOr` readyState `jsEq` JSString "loaded"
414+
415+ readyState :: JS
416+ readyState = JSProj (JSIdent "document") "readyState"
417+
418+ mainFun :: JS
419+ mainFun =
420+ JSSeq [ JSAlloc "vm" (Just $ JSNew "i$VM" [])
421+ , JSApp (JSIdent "i$SCHED") [JSIdent "vm"]
422+ , JSApp (
423+ JSIdent (translateName (sMN 0 "runMain"))
424+ ) [JSNum (JSInt 0)]
425+ , JSWhile (JSProj jsCALLSTACK "length") (
426+ JSSeq [ JSAlloc "func" (Just jsPOP)
427+ , JSAlloc "args" (Just jsPOP)
428+ , JSApp (JSProj (JSIdent "func") "apply") [JSThis, JSIdent "args"]
429+ ]
430+ )
431+ ]
432+
397 invokeMain :: String
433 invokeMain :: String
398 invokeMain = compileJS $ JSApp (JSIdent "main") []
434 invokeMain = compileJS $ JSApp (JSIdent "main") []
399
435
@@ -421,8 +457,6 @@ splitFunction (JSAlloc name (Just (JSFunction args body@(JSSeq _)))) = do
421 processBranches =
457 processBranches =
422 traverse (runKleisli (arr id *** (Kleisli splitSequence)))
458 traverse (runKleisli (arr id *** (Kleisli splitSequence)))
423
459
424− splitCondition js = return js
425−
426 splitSequence :: JS -> RWS () [(Int, JS)] Int JS
460 splitSequence :: JS -> RWS () [(Int, JS)] Int JS
427 splitSequence js@(JSSeq seq) = do
461 splitSequence js@(JSSeq seq) = do
428 let (pre,post) = break isCall seq in
462 let (pre,post) = break isCall seq in
@@ -716,6 +750,12 @@ jsOr lhs rhs = JSBinOp "||" lhs rhs
716jsAnd :: JS -> JS -> JS
750jsAnd :: JS -> JS -> JS
717jsAnd lhs rhs = JSBinOp "&&" lhs rhs
751jsAnd lhs rhs = JSBinOp "&&" lhs rhs
718
752
753+jsMeth :: JS -> String -> [JS] -> JS
754+jsMeth obj meth args = JSApp (JSProj obj meth) args
755+
756+jsCall :: String -> [JS] -> JS
757+jsCall fun args = JSApp (JSIdent fun) args
758+
719jsTypeOf :: JS -> JS
759jsTypeOf :: JS -> JS
720jsTypeOf js = JSPreOp "typeof " js
760jsTypeOf js = JSPreOp "typeof " js
721
761
@@ -1398,12 +1438,6 @@ jsOP _ reg op args = JSAssign (translateReg reg) jsOP'
1398 invokeMeth obj meth args =
1438 invokeMeth obj meth args =
1399 JSApp (JSProj (translateReg obj) meth) $ map translateReg args
1439 JSApp (JSProj (translateReg obj) meth) $ map translateReg args
1400
1440
1401− jsMeth :: JS -> String -> [JS] -> JS
1402− jsMeth obj meth args = JSApp (JSProj obj meth) args
1403−
1404−
1405− jsCall :: String -> [JS] -> JS
1406− jsCall fun args = JSApp (JSIdent fun) args
1407
1441
1408jsRESERVE :: CompileInfo -> Int -> JS
1442jsRESERVE :: CompileInfo -> Int -> JS
1409jsRESERVE _ _ = JSNoop
1443jsRESERVE _ _ = JSNoop