@@ -52,6 +52,13 @@ data JSNum = JSInt Int
5252 deriving Eq
5353
5454
55+data JSAnnotation = JSConstructor deriving Eq
56+
57+
58+instance Show JSAnnotation where
59+ show JSConstructor = "constructor"
60+
61+
5562data JS = JSRaw String
5663 | JSIdent String
5764 | JSFunction [String] JS
@@ -81,6 +88,7 @@ data JS = JSRaw String
8188 | JSParens JS
8289 | JSWhile JS JS
8390 | JSFFI String [JS]
91+ | JSAnnotation JSAnnotation JS
8492 | JSNoop
8593 deriving Eq
8694
@@ -123,6 +131,9 @@ ffi code args = let parsed = ffiParse code in
123131compileJS :: JS -> String
124132compileJS JSNoop = ""
125133
134+compileJS (JSAnnotation annotation js) =
135+ "/** @" ++ show annotation ++ " */\n" ++ compileJS js
136+
126137compileJS (JSFFI raw args) =
127138 ffi raw (map compileJS args)
128139
@@ -357,6 +368,8 @@ foldJS tr add acc js =
357368 add (tr js) $ add (fold cond) (fold body)
358369 | JSFFI raw args <- js =
359370 add (tr js) $ foldl' add acc $ map fold args
371+ | JSAnnotation a js <- js =
372+ add (tr js) $ fold js
360373 | otherwise =
361374 tr js
362375
@@ -385,6 +398,7 @@ transformJS tr js =
385398 | JSParens val <- js = JSParens $ tr val
386399 | JSWhile cond body <- js = JSWhile (tr cond) (tr body)
387400 | JSFFI raw args <- js = JSFFI raw (map tr args)
401+ | JSAnnotation a js <- js = JSAnnotation a (tr js)
388402 | otherwise = js
389403
390404
@@ -392,6 +406,9 @@ moveJSDeclToTop :: String -> [JS] -> [JS]
392406moveJSDeclToTop decl js = move ([], js)
393407 where
394408 move :: ([JS], [JS]) -> [JS]
409+ move (front, js@(JSAnnotation _ (JSAlloc name _)):back)
410+ | name == decl = js : front ++ back
411+
395412 move (front, js@(JSAlloc name _):back)
396413 | name == decl = js : front ++ back
397414
@@ -1054,7 +1071,7 @@ unfoldLookupTable input =
10541071 adaptCon js =
10551072 adaptCon' [] js
10561073 where
1057− adaptCon' front ((JSAlloc "__IDRRT__Con" (Just _)):back) =
1074+ adaptCon' front ((JSAnnotation _ (JSAlloc "__IDRRT__Con" _)):back) =
10581075 front ++ (new:back)
10591076
10601077 adaptCon' front (next:back) =
@@ -1064,11 +1081,12 @@ unfoldLookupTable input =
10641081
10651082
10661083 new =
1067− JSAlloc "__IDRRT__Con" (Just $
1068− JSFunction newArgs (
1069− JSSeq (map newVar newArgs)
1084+ JSAnnotation JSConstructor $
1085+ JSAlloc "__IDRRT__Con" (Just $
1086+ JSFunction newArgs (
1087+ JSSeq (map newVar newArgs)
1088+ )
10701089 )
1071− )
10721090 where
10731091 newVar var = JSAssign (JSProj JSThis var) (JSIdent var)
10741092 newArgs = ["tag", "eval", "app", "vars"]
@@ -1438,14 +1456,16 @@ codegenJavaScript target definitions includes filename outputType = do
14381456
14391457 prelude :: [JS]
14401458 prelude =
1441− [ JSAlloc (idrRTNamespace ++ "Cont") (Just $ JSFunction ["k"] (
1442− JSAssign (JSProj JSThis "k") (JSIdent "k")
1443− ))
1444− , JSAlloc (idrRTNamespace ++ "Con") (Just $ JSFunction ["tag", "vars"] (
1445− JSSeq [ JSAssign (JSProj JSThis "tag") (JSIdent "tag")
1446− , JSAssign (JSProj JSThis "vars") (JSIdent "vars")
1447− ]
1448− ))
1459+ [ JSAnnotation JSConstructor $
1460+ JSAlloc (idrRTNamespace ++ "Cont") (Just $ JSFunction ["k"] (
1461+ JSAssign (JSProj JSThis "k") (JSIdent "k")
1462+ ))
1463+ , JSAnnotation JSConstructor $
1464+ JSAlloc (idrRTNamespace ++ "Con") (Just $ JSFunction ["tag", "vars"] (
1465+ JSSeq [ JSAssign (JSProj JSThis "tag") (JSIdent "tag")
1466+ , JSAssign (JSProj JSThis "vars") (JSIdent "vars")
1467+ ]
1468+ ))
14491469 ]
14501470
14511471 mainLoop :: JS