git.iko.soy/Idris-dev
on master help sign in
javascript: add google closure annotations to AST
1a172b2raichoo
src/IRTS/CodegenJavaScript.hs+33−13
compare with master
unifiedsplit
@@ -52,6 +52,13 @@ data JSNum = JSInt Int
52 deriving Eq
52 deriving Eq
53
53
54
54
55+data JSAnnotation = JSConstructor deriving Eq
56+
57+
58+instance Show JSAnnotation where
59+ show JSConstructor = "constructor"
60+
61+
55data JS = JSRaw String
62data JS = JSRaw String
56 | JSIdent String
63 | JSIdent String
57 | JSFunction [String] JS
64 | JSFunction [String] JS
@@ -81,6 +88,7 @@ data JS = JSRaw String
81 | JSParens JS
88 | JSParens JS
82 | JSWhile JS JS
89 | JSWhile JS JS
83 | JSFFI String [JS]
90 | JSFFI String [JS]
91+ | JSAnnotation JSAnnotation JS
84 | JSNoop
92 | JSNoop
85 deriving Eq
93 deriving Eq
86
94
@@ -123,6 +131,9 @@ ffi code args = let parsed = ffiParse code in
123compileJS :: JS -> String
131compileJS :: JS -> String
124compileJS JSNoop = ""
132compileJS JSNoop = ""
125
133
134+compileJS (JSAnnotation annotation js) =
135+ "/** @" ++ show annotation ++ " */\n" ++ compileJS js
136+
126compileJS (JSFFI raw args) =
137compileJS (JSFFI raw args) =
127 ffi raw (map compileJS args)
138 ffi raw (map compileJS args)
128
139
@@ -357,6 +368,8 @@ foldJS tr add acc js =
357 add (tr js) $ add (fold cond) (fold body)
368 add (tr js) $ add (fold cond) (fold body)
358 | JSFFI raw args <- js =
369 | JSFFI raw args <- js =
359 add (tr js) $ foldl' add acc $ map fold args
370 add (tr js) $ foldl' add acc $ map fold args
371+ | JSAnnotation a js <- js =
372+ add (tr js) $ fold js
360 | otherwise =
373 | otherwise =
361 tr js
374 tr js
362
375
@@ -385,6 +398,7 @@ transformJS tr js =
385 | JSParens val <- js = JSParens $ tr val
398 | JSParens val <- js = JSParens $ tr val
386 | JSWhile cond body <- js = JSWhile (tr cond) (tr body)
399 | JSWhile cond body <- js = JSWhile (tr cond) (tr body)
387 | JSFFI raw args <- js = JSFFI raw (map tr args)
400 | JSFFI raw args <- js = JSFFI raw (map tr args)
401+ | JSAnnotation a js <- js = JSAnnotation a (tr js)
388 | otherwise = js
402 | otherwise = js
389
403
390
404
@@ -392,6 +406,9 @@ moveJSDeclToTop :: String -> [JS] -> [JS]
392moveJSDeclToTop decl js = move ([], js)
406moveJSDeclToTop decl js = move ([], js)
393 where
407 where
394 move :: ([JS], [JS]) -> [JS]
408 move :: ([JS], [JS]) -> [JS]
409+ move (front, js@(JSAnnotation _ (JSAlloc name _)):back)
410+ | name == decl = js : front ++ back
411+
395 move (front, js@(JSAlloc name _):back)
412 move (front, js@(JSAlloc name _):back)
396 | name == decl = js : front ++ back
413 | name == decl = js : front ++ back
397
414
@@ -1054,7 +1071,7 @@ unfoldLookupTable input =
1054 adaptCon js =
1071 adaptCon js =
1055 adaptCon' [] js
1072 adaptCon' [] js
1056 where
1073 where
1057− adaptCon' front ((JSAlloc "__IDRRT__Con" (Just _)):back) =
1074+ adaptCon' front ((JSAnnotation _ (JSAlloc "__IDRRT__Con" _)):back) =
1058 front ++ (new:back)
1075 front ++ (new:back)
1059
1076
1060 adaptCon' front (next:back) =
1077 adaptCon' front (next:back) =
@@ -1064,11 +1081,12 @@ unfoldLookupTable input =
1064
1081
1065
1082
1066 new =
1083 new =
1084+ JSAnnotation JSConstructor $
1067− JSAlloc "__IDRRT__Con" (Just $
1085+ JSAlloc "__IDRRT__Con" (Just $
1068− JSFunction newArgs (
1086+ JSFunction newArgs (
1069− JSSeq (map newVar newArgs)
1087+ JSSeq (map newVar newArgs)
1088+ )
1070 )
1089 )
1071− )
1072 where
1090 where
1073 newVar var = JSAssign (JSProj JSThis var) (JSIdent var)
1091 newVar var = JSAssign (JSProj JSThis var) (JSIdent var)
1074 newArgs = ["tag", "eval", "app", "vars"]
1092 newArgs = ["tag", "eval", "app", "vars"]
@@ -1438,14 +1456,16 @@ codegenJavaScript target definitions includes filename outputType = do
1438
1456
1439 prelude :: [JS]
1457 prelude :: [JS]
1440 prelude =
1458 prelude =
1459+ [ JSAnnotation JSConstructor $
1441− [ JSAlloc (idrRTNamespace ++ "Cont") (Just $ JSFunction ["k"] (
1460+ JSAlloc (idrRTNamespace ++ "Cont") (Just $ JSFunction ["k"] (
1442− JSAssign (JSProj JSThis "k") (JSIdent "k")
1461+ JSAssign (JSProj JSThis "k") (JSIdent "k")
1443− ))
1462+ ))
1463+ , JSAnnotation JSConstructor $
1444− , JSAlloc (idrRTNamespace ++ "Con") (Just $ JSFunction ["tag", "vars"] (
1464+ JSAlloc (idrRTNamespace ++ "Con") (Just $ JSFunction ["tag", "vars"] (
1445− JSSeq [ JSAssign (JSProj JSThis "tag") (JSIdent "tag")
1465+ JSSeq [ JSAssign (JSProj JSThis "tag") (JSIdent "tag")
1446− , JSAssign (JSProj JSThis "vars") (JSIdent "vars")
1466+ , JSAssign (JSProj JSThis "vars") (JSIdent "vars")
1447− ]
1467+ ]
1448− ))
1468+ ))
1449 ]
1469 ]
1450
1470
1451 mainLoop :: JS
1471 mainLoop :: JS