@@ -246,14 +246,17 @@ jsLet name value body =
246246 ) [value]
247247
248248
249−jsSubst :: String -> JS -> JS -> JS
250−jsSubst var new (JSVar old)
249+jsSubst :: JS -> JS -> JS -> JS
250+jsSubst var new old
251+ | var == old = new
252+
253+jsSubst (JSIdent var) new (JSVar old)
251254 | var == translateVariableName old = new
252− | otherwise = JSVar old
255+ | otherwise = JSVar old
253256
254−jsSubst var new (JSIdent old)
257+jsSubst var new old@(JSIdent _)
255258 | var == old = new
256− | otherwise = JSIdent old
259+ | otherwise = old
257260
258261jsSubst var new (JSArray fields) =
259262 JSArray (map (jsSubst var new) fields)
@@ -261,25 +264,25 @@ jsSubst var new (JSArray fields) =
261264jsSubst var new (JSNew con vals) =
262265 JSNew con $ map (jsSubst var new) vals
263266
264−jsSubst var new (JSApp (JSProj (JSFunction args body) "apply") vals)
267+jsSubst (JSIdent var) new (JSApp (JSProj (JSFunction args body) "apply") vals)
265268 | var `notElem` args =
266− JSApp (JSProj (JSFunction args (jsSubst var new body)) "apply") (
267− map (jsSubst var new) vals
269+ JSApp (JSProj (JSFunction args (jsSubst (JSIdent var) new body)) "apply") (
270+ map (jsSubst (JSIdent var) new) vals
268271 )
269272 | otherwise =
270273 JSApp (JSProj (JSFunction args body) "apply") (
271− map (jsSubst var new) vals
274+ map (jsSubst (JSIdent var) new) vals
272275 )
273276
274−jsSubst var new (JSApp (JSFunction [arg] body) vals)
277+jsSubst (JSIdent var) new (JSApp (JSFunction [arg] body) vals)
275278 | var /= arg =
276279 JSApp (JSFunction [arg] (
277− jsSubst var new body
278− )) $ map (jsSubst var new) vals
280+ jsSubst (JSIdent var) new body
281+ )) $ map (jsSubst (JSIdent var) new) vals
279282 | otherwise =
280283 JSApp (JSFunction [arg] (
281284 body
282− )) $ map (jsSubst var new) vals
285+ )) $ map (jsSubst (JSIdent var) new) vals
283286
284287jsSubst var new (JSApp lhs rhs) =
285288 JSApp (jsSubst var new lhs) (map (jsSubst var new) rhs)
@@ -324,7 +327,7 @@ removeAllocations (JSSeq body) =
324327 removeHelper :: [JS] -> [JS]
325328 removeHelper [js] = [js]
326329 removeHelper ((JSAlloc name (Just val@(JSIdent _))):js) =
327− map (jsSubst name val) (removeHelper js)
330+ map (jsSubst (JSIdent name) val) (removeHelper js)
328331 removeHelper (j:js) = j : removeHelper js
329332
330333removeAllocations (JSFunction args body) =
@@ -378,7 +381,7 @@ isJSConstant js
378381
379382inlineJS :: JS -> JS
380383inlineJS (JSReturn (JSApp (JSFunction ["cse"] body) [val@(JSVar _)])) =
381− inlineJS $ jsSubst "cse" val body
384+ inlineJS $ jsSubst (JSIdent "cse") val body
382385
383386inlineJS (JSReturn (JSApp (JSFunction [arg] cond@(JSCond _)) [val])) =
384387 JSSeq [ JSAlloc arg (Just (inlineJS val))
@@ -394,7 +397,7 @@ inlineJS (JSApp (JSProj (JSFunction args (JSReturn body)) "apply") [
394397 inlineApply [] body _ = inlineJS body
395398 inlineApply (a:as) body n =
396399 inlineApply as (
397− jsSubst a (JSIndex (JSProj var "vars") (JSNum (JSInt n))) body
400+ jsSubst (JSIdent a) (JSIndex (JSProj var "vars") (JSNum (JSInt n))) body
398401 ) (n + 1)
399402
400403inlineJS (JSApp (JSIdent "__IDR__mEVAL0") [val])
@@ -408,33 +411,43 @@ inlineJS (JSApp (JSIdent "__IDRRT__tailcall") [
408411inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
409412 | JSNew con [tag, vals] <- ret
410413 , opt <- inlineJS val =
411− JSNew con [tag, jsSubst arg opt vals]
414+ JSNew con [tag, jsSubst (JSIdent arg) opt vals]
412415
413416 | JSNew con [JSFunction [] (JSReturn (JSApp fun vars))] <- ret
414417 , opt <- inlineJS val =
415418 JSNew con [JSFunction [] (
416− JSReturn $ JSApp (jsSubst arg opt fun) (map (jsSubst arg opt) vars)
419+ JSReturn (
420+ JSApp (
421+ jsSubst (JSIdent arg) opt fun
422+ ) (
423+ map (jsSubst (JSIdent arg) opt) vars
424+ )
425+ )
417426 )]
418427
419428 | JSApp (JSProj obj field) args <- ret
420429 , opt <- inlineJS val =
421− JSApp (JSProj (jsSubst arg opt obj) field) $ map (jsSubst arg opt) args
430+ JSApp (
431+ JSProj (jsSubst (JSIdent arg) opt obj) field
432+ ) (
433+ map (jsSubst (JSIdent arg) opt) args
434+ )
422435
423436 | JSIndex (JSProj obj field) idx <- ret
424437 , opt <- inlineJS val =
425438 JSIndex (JSProj (
426− jsSubst arg opt obj
439+ jsSubst (JSIdent arg) opt obj
427440 ) field
428− ) (jsSubst arg opt idx)
441+ ) (jsSubst (JSIdent arg) opt idx)
429442
430443 | JSOp op lhs rhs <- ret
431444 , opt <- inlineJS val =
432− JSOp op (jsSubst arg opt lhs) $
433− (jsSubst arg opt rhs)
445+ JSOp op (jsSubst (JSIdent arg) opt lhs) $
446+ (jsSubst (JSIdent arg) opt rhs)
434447
435448 | JSApp (JSIdent fun) args <- ret
436449 , opt <- inlineJS val =
437− JSApp (JSIdent fun) $ map (jsSubst arg opt) args
450+ JSApp (JSIdent fun) $ map (jsSubst (JSIdent arg) opt) args
438451
439452inlineJS (JSApp fun args) =
440453 JSApp (inlineJS fun) (map inlineJS args)
@@ -480,6 +493,11 @@ reduceJS js = reduceLoop [] ([], js)
480493funName :: JS -> String
481494funName (JSAlloc fun _) = fun
482495
496+elimDeadLoop :: [JS] -> [JS]
497+elimDeadLoop js
498+ | ret <- deadEvalApplyCases js
499+ , ret /= js = elimDeadLoop ret
500+ | otherwise = js
483501
484502deadEvalApplyCases :: [JS] -> [JS]
485503deadEvalApplyCases js =
@@ -816,6 +834,131 @@ reduceConstants js
816834 , ret /= js = reduceConstants ret
817835 | otherwise = js
818836
837+
838+elimDuplicateEvals :: JS -> JS
839+elimDuplicateEvals (JSAlloc fun (Just (JSFunction args (JSSeq seq)))) =
840+ JSAlloc fun $ Just (JSFunction args $ JSSeq (elimHelper seq))
841+ where
842+ elimHelper :: [JS] -> [JS]
843+ elimHelper (j@(JSAlloc var (Just val)):js) =
844+ j : map (jsSubst val (JSIdent var)) (elimHelper js)
845+ elimHelper (j:js) =
846+ j : elimHelper js
847+ elimHelper [] = []
848+
849+elimDuplicateEvals js = js
850+
851+optimizeEvalTailcalls :: (String, String) -> JS -> JS
852+optimizeEvalTailcalls (fun, tc) js =
853+ optHelper js
854+ where
855+ optHelper :: JS -> JS
856+ optHelper (JSApp (JSIdent "__IDRRT__tailcall") [
857+ JSFunction [] (JSReturn (JSApp (JSIdent n) args))
858+ ])
859+ | n == fun = JSApp (JSIdent tc) $ map optHelper args
860+
861+ optHelper (JSFunction args body) =
862+ JSFunction args $ optHelper body
863+
864+ optHelper (JSSeq seq) =
865+ JSSeq $ map optHelper seq
866+
867+ optHelper (JSReturn ret) =
868+ JSReturn $ optHelper ret
869+
870+ optHelper (JSApp lhs rhs) =
871+ JSApp (optHelper lhs) (map optHelper rhs)
872+
873+ optHelper (JSNew con args) =
874+ JSNew con $ map optHelper args
875+
876+ optHelper (JSOp op lhs rhs) =
877+ JSOp op (optHelper lhs) (optHelper rhs)
878+
879+ optHelper (JSProj obj field) =
880+ JSProj (optHelper obj) field
881+
882+ optHelper (JSArray vals) =
883+ JSArray $ map optHelper vals
884+
885+ optHelper (JSAssign lhs rhs) =
886+ JSAssign (optHelper lhs) (optHelper rhs)
887+
888+ optHelper (JSAlloc var (Just val)) =
889+ JSAlloc var (Just $ optHelper val)
890+
891+ optHelper (JSIndex lhs rhs) =
892+ JSIndex (optHelper lhs) (optHelper rhs)
893+
894+ optHelper (JSCond conds) =
895+ JSCond $ map (optHelper *** optHelper) conds
896+
897+ optHelper (JSTernary c t f) =
898+ JSTernary (
899+ optHelper c
900+ ) (
901+ optHelper t
902+ ) (
903+ optHelper f
904+ )
905+
906+ optHelper js = js
907+
908+
909+removeInstanceChecks :: JS -> JS
910+removeInstanceChecks (JSCond conds) =
911+ JSCond $ map (removeHelper *** removeInstanceChecks) conds
912+ where
913+ removeHelper (
914+ JSOp "&&" (JSOp "instanceof" _ (JSIdent "__IDRRT__Con")) check
915+ ) = removeHelper check
916+ removeHelper js = js
917+
918+removeInstanceChecks (JSFunction args body) =
919+ JSFunction args $ removeInstanceChecks body
920+
921+removeInstanceChecks (JSSeq seq) =
922+ JSSeq $ map removeInstanceChecks seq
923+
924+removeInstanceChecks (JSReturn ret) =
925+ JSReturn $ removeInstanceChecks ret
926+
927+removeInstanceChecks (JSApp lhs rhs) =
928+ JSApp (removeInstanceChecks lhs) $ map removeInstanceChecks rhs
929+
930+removeInstanceChecks (JSNew con args) =
931+ JSNew con $ map removeInstanceChecks args
932+
933+removeInstanceChecks (JSOp op lhs rhs) =
934+ JSOp op (removeInstanceChecks lhs) (removeInstanceChecks rhs)
935+
936+removeInstanceChecks (JSProj obj field) =
937+ JSProj (removeInstanceChecks obj) field
938+
939+removeInstanceChecks (JSArray vals) =
940+ JSArray $ map removeInstanceChecks vals
941+
942+removeInstanceChecks (JSAssign lhs rhs) =
943+ JSAssign (removeInstanceChecks lhs) (removeInstanceChecks rhs)
944+
945+removeInstanceChecks (JSAlloc var (Just val)) =
946+ JSAlloc var (Just $ removeInstanceChecks val)
947+
948+removeInstanceChecks (JSIndex lhs rhs) =
949+ JSIndex (removeInstanceChecks lhs) (removeInstanceChecks rhs)
950+
951+removeInstanceChecks (JSTernary c t f) =
952+ JSTernary (
953+ removeInstanceChecks c
954+ ) (
955+ removeInstanceChecks t
956+ ) (
957+ removeInstanceChecks f
958+ )
959+
960+removeInstanceChecks js = js
961+
819962reduceLoop :: [String] -> ([JS], [JS]) -> [JS]
820963reduceLoop reduced (cons, program) =
821964 case partition findConstructors program of
@@ -942,8 +1085,13 @@ codegenJavaScript target definitions filename outputType = do
9421085 constRemoved = map reduceConstants reduced
9431086 constrInit = initConstructors constRemoved
9441087 removeAlloc = map removeAllocations constrInit
945− deadElim = deadEvalApplyCases removeAlloc
946− js = inlineFunctions deadElim in
1088+ deadElim = elimDeadLoop removeAlloc
1089+ inlined = inlineFunctions deadElim
1090+ elimDup = map elimDuplicateEvals inlined
1091+ evalTC = map (optimizeEvalTailcalls ("__IDR__mEVAL0", "__IDRRT__EVALTC")) elimDup
1092+ applyTC = map (optimizeEvalTailcalls ("__IDR__mAPPLY0", "__IDRRT__APPLYTC")) evalTC
1093+ remChecks = map removeInstanceChecks applyTC
1094+ js = remChecks in
9471095 map compileJS js
9481096
9491097 mainLoop :: JS