@@ -80,10 +80,13 @@ data JS = JSRaw String
8080 | JSTernary JS JS JS
8181 | JSParens JS
8282 | JSWhile JS JS
83+ | JSNoop
8384 deriving Eq
8485
8586
8687compileJS :: JS -> String
88+compileJS JSNoop = ""
89+
8790compileJS (JSRaw code) =
8891 code
8992
@@ -184,7 +187,7 @@ compileJS (JSCond branches) =
184187 intercalate " else " $ map createIfBlock branches
185188 where
186189 createIfBlock (JSTrue, e) =
187− "{\n"
190+ "if (true) {\n"
188191 ++ compileJS e
189192 ++ ";\n}"
190193 createIfBlock (cond, e) =
@@ -938,6 +941,7 @@ unfoldLookupTable input =
938941 | fun == lt = (js, front ++ back)
939942
940943 extractLT' (front, js:back) = extractLT' (front ++ [js], back)
944+ extractLT' (front, back) = (JSNoop, front ++ back)
941945
942946
943947 expandLT :: String -> JS -> [(Int, JS)]
@@ -951,6 +955,8 @@ unfoldLookupTable input =
951955
952956 expandEntry js = Nothing
953957
958+ expandLT lt JSNoop = []
959+
954960
955961removeInstanceChecks :: JS -> JS
956962removeInstanceChecks (JSCond conds) =
@@ -1237,24 +1243,24 @@ codegenJavaScript target definitions filename outputType = do
12371243 compile =
12381244 map compileJS
12391245
1240− opt =
1241− [ map optimizeJS
1242− , removeIDs
1243− , reduceJS
1244− , map reduceConstants
1245− , initConstructors
1246− , map removeAllocations
1247− , elimDeadLoop
1248− , map elimDuplicateEvals
1249− , optimizeRuntimeCalls "__IDR__mEVAL0" "__IDRRT__EVALTC"
1250− , optimizeRuntimeCalls "__IDR__mAPPLY0" "__IDRRT__APPLYTC"
1251− , map removeInstanceChecks
1252− , inlineFunctions
1253− , map reduceContinuations
1254− , extractLocalConstructors
1255− , unfoldLookupTable
1256− , evalCons
1257− ]
1246+ opt = []
1247+ {-[ map optimizeJS-}
1248+ {-, removeIDs-}
1249+ {-, reduceJS-}
1250+ {-, map reduceConstants-}
1251+ {-, initConstructors-}
1252+ {-, map removeAllocations-}
1253+ {-, elimDeadLoop-}
1254+ {-, map elimDuplicateEvals-}
1255+ {-, optimizeRuntimeCalls "__IDR__mEVAL0" "__IDRRT__EVALTC"-}
1256+ {-, optimizeRuntimeCalls "__IDR__mAPPLY0" "__IDRRT__APPLYTC"-}
1257+ {-, map removeInstanceChecks-}
1258+ {-, inlineFunctions-}
1259+ {-, map reduceContinuations-}
1260+ {-, extractLocalConstructors-}
1261+ {-, unfoldLookupTable-}
1262+ {-, evalCons-}
1263+ {-]-}
12581264
12591265 prelude :: [JS]
12601266 prelude =
@@ -1413,42 +1419,42 @@ translateConstant c =
14131419
14141420translateDeclaration :: (String, SDecl) -> [JS]
14151421translateDeclaration (path, SFun name params stackSize body)
1416− | (MN _ ap) <- name
1417− , (SLet var val next) <- body
1418− , (SChkCase cvar cases) <- next
1419− , ap == txt "APPLY" =
1420− let lvar = translateVariableName var
1421− lookup t = (JSApp
1422− (JSIndex (JSIdent t) (JSProj (JSIdent lvar) "tag"))
1423− [JSIdent "fn0", JSIdent "arg0", JSIdent lvar]) in
1424− [ lookupTable "APPLY" [(var, "chk")] var cases
1425− , jsDecl $ JSFunction ["fn0", "arg0"] (
1426− JSSeq [ JSAlloc "__var_0" (Just $ JSIdent "fn0")
1427− , JSAlloc (translateVariableName var) (
1428− Just $ translateExpression val
1429− )
1430− , JSReturn $ (JSTernary (
1431− (JSVar var `jsInstanceOf` jsCon) `jsAnd`
1432− (hasProp (idrLTNamespace ++ "APPLY") (translateVariableName var))
1433− ) (lookup (idrLTNamespace ++ "APPLY")) JSNull)
1434− ]
1435− )
1436− ]
1437−
1438− | (MN _ ev) <- name
1439− , (SChkCase var cases) <- body
1440− , ev == txt "EVAL" =
1441− [ lookupTable "EVAL" [] var cases
1442− , jsDecl $ JSFunction ["arg0"] (JSReturn $
1443− JSTernary (
1444− (JSIdent "arg0" `jsInstanceOf` jsCon) `jsAnd`
1445− (hasProp (idrLTNamespace ++ "EVAL") "arg0")
1446− ) (JSApp
1447− (JSIndex (JSIdent (idrLTNamespace ++ "EVAL")) (JSProj (JSIdent "arg0") "tag"))
1448− [JSIdent "arg0"]
1449− ) (JSIdent "arg0")
1450− )
1451− ]
1422+ {-| (MN _ ap) <- name-}
1423+ {-, (SLet var val next) <- body-}
1424+ {-, (SChkCase cvar cases) <- next-}
1425+ {-, ap == txt "APPLY" =-}
1426+ {-let lvar = translateVariableName var-}
1427+ {-lookup t = (JSApp-}
1428+ {-(JSIndex (JSIdent t) (JSProj (JSIdent lvar) "tag"))-}
1429+ {-[JSIdent "fn0", JSIdent "arg0", JSIdent lvar]) in-}
1430+ {-[ lookupTable "APPLY" [(var, "chk")] var cases-}
1431+ {-, jsDecl $ JSFunction ["fn0", "arg0"] (-}
1432+ {-JSSeq [ JSAlloc "__var_0" (Just $ JSIdent "fn0")-}
1433+ {-, JSAlloc (translateVariableName var) (-}
1434+ {-Just $ translateExpression val-}
1435+ {-)-}
1436+ {-, JSReturn $ (JSTernary (-}
1437+ {-(JSVar var `jsInstanceOf` jsCon) `jsAnd`-}
1438+ {-(hasProp (idrLTNamespace ++ "APPLY") (translateVariableName var))-}
1439+ {-) (lookup (idrLTNamespace ++ "APPLY")) JSNull)-}
1440+ {-]-}
1441+ {-)-}
1442+ {-]-}
1443+
1444+ {-| (MN _ ev) <- name-}
1445+ {-, (SChkCase var cases) <- body-}
1446+ {-, ev == txt "EVAL" =-}
1447+ {-[ lookupTable "EVAL" [] var cases-}
1448+ {-, jsDecl $ JSFunction ["arg0"] (JSReturn $-}
1449+ {-JSTernary (-}
1450+ {-(JSIdent "arg0" `jsInstanceOf` jsCon) `jsAnd`-}
1451+ {-(hasProp (idrLTNamespace ++ "EVAL") "arg0")-}
1452+ {-) (JSApp-}
1453+ {-(JSIndex (JSIdent (idrLTNamespace ++ "EVAL")) (JSProj (JSIdent "arg0") "tag"))-}
1454+ {-[JSIdent "arg0"]-}
1455+ {-) (JSIdent "arg0")-}
1456+ {-)-}
1457+ {-]-}
14521458 | otherwise =
14531459 let fun = translateExpression body in
14541460 [jsDecl $ jsFun fun]