@@ -262,6 +262,29 @@ jsError :: String -> JS
262262jsError err = JSApp (JSFunction [] (JSError err)) []
263263
264264
265+transformJS :: (JS -> JS) -> JS -> JS
266+transformJS tr js =
267+ transformHelper js
268+ where
269+ transformHelper :: JS -> JS
270+ transformHelper js
271+ | JSFunction args body <- js = JSFunction args $ tr body
272+ | JSSeq seq <- js = JSSeq $ map tr seq
273+ | JSReturn ret <- js = JSReturn $ tr ret
274+ | JSApp lhs rhs <- js = JSApp (tr lhs) $ map tr rhs
275+ | JSNew con args <- js = JSNew con $ map tr args
276+ | JSOp op lhs rhs <- js = JSOp op (tr lhs) (tr rhs)
277+ | JSProj obj field <- js = JSProj (tr obj) field
278+ | JSArray vals <- js = JSArray $ map tr vals
279+ | JSAssign lhs rhs <- js = JSAssign (tr lhs) (tr rhs)
280+ | JSAlloc var val <- js = JSAlloc var $ fmap tr val
281+ | JSIndex lhs rhs <- js = JSIndex (tr lhs) (tr rhs)
282+ | JSCond conds <- js = JSCond $ map (tr *** tr) conds
283+ | JSTernary c t f <- js = JSTernary (tr c) (tr t) (tr f)
284+ | JSParens val <- js = JSParens $ tr val
285+ | otherwise = js
286+
287+
265288jsSubst :: JS -> JS -> JS -> JS
266289jsSubst var new old
267290 | var == old = new
@@ -300,40 +323,7 @@ jsSubst (JSIdent var) new (JSApp (JSFunction [arg] body) vals)
300323 body
301324 )) $ map (jsSubst (JSIdent var) new) vals
302325
303−jsSubst var new (JSApp lhs rhs) =
304− JSApp (jsSubst var new lhs) (map (jsSubst var new) rhs)
305−
306−jsSubst var new (JSFunction [] body) =
307− JSFunction [] (jsSubst var new body)
308−
309−jsSubst var new (JSReturn ret) =
310− JSReturn $ jsSubst var new ret
311−
312−jsSubst var new (JSProj obj field) =
313− JSProj (jsSubst var new obj) field
314−
315−jsSubst var new (JSSeq body) =
316− JSSeq $ map (jsSubst var new) body
317−
318−jsSubst var new (JSOp op lhs rhs) =
319− JSOp op (jsSubst var new lhs) (jsSubst var new rhs)
320−
321−jsSubst var new (JSIndex obj field) =
322− JSIndex (jsSubst var new obj) (jsSubst var new field)
323−
324−jsSubst var new (JSCond conds) =
325− JSCond (map ((jsSubst var new) *** (jsSubst var new)) conds)
326−
327−jsSubst var new (JSAssign lhs rhs) =
328− JSAssign (jsSubst var new lhs) (jsSubst var new rhs)
329−
330−jsSubst var new (JSAlloc val (Just js)) =
331− JSAlloc val (Just (jsSubst var new js))
332−
333−jsSubst var new (JSParens js) =
334− JSParens $ jsSubst var new js
335−
336−jsSubst _ _ js = js
326+jsSubst var new js = transformJS (jsSubst var new) js
337327
338328
339329removeAllocations :: JS -> JS
@@ -349,46 +339,7 @@ removeAllocations (JSSeq body) =
349339 map (jsSubst (JSIdent name) val) (removeHelper js)
350340 removeHelper (j:js) = j : removeHelper js
351341
352−removeAllocations (JSFunction args body) =
353− JSFunction args $ removeAllocations body
354−
355−removeAllocations (JSReturn ret) =
356− JSReturn $ removeAllocations ret
357−
358−removeAllocations (JSApp fun args) =
359− JSApp (removeAllocations fun) (map removeAllocations args)
360−
361−removeAllocations (JSNew con args) =
362− JSNew con $ map removeAllocations args
363−
364−removeAllocations (JSOp op lhs rhs) =
365− JSOp op (removeAllocations lhs) (removeAllocations rhs)
366−
367−removeAllocations (JSProj obj field) =
368− JSProj (removeAllocations obj) field
369−
370−removeAllocations (JSArray vals) =
371− JSArray $ map removeAllocations vals
372−
373−removeAllocations (JSAssign lhs rhs) =
374− JSAssign (removeAllocations lhs) (removeAllocations rhs)
375−
376−removeAllocations (JSAlloc name (Just val)) =
377− JSAlloc name $ Just (removeAllocations val)
378−
379−removeAllocations (JSIndex val idx) =
380− JSIndex (removeAllocations val) (removeAllocations idx)
381−
382−removeAllocations (JSCond conds) =
383− JSCond $ map (removeAllocations *** removeAllocations) conds
384−
385−removeAllocations (JSTernary c t f) =
386− JSTernary (removeAllocations c) (removeAllocations t) (removeAllocations f)
387−
388−removeAllocations (JSParens js) =
389− JSParens $ removeAllocations js
390−
391−removeAllocations js = js
342+removeAllocations js = transformJS removeAllocations js
392343
393344
394345isJSConstant :: JS -> Bool
@@ -474,43 +425,7 @@ inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
474425 , opt <- inlineJS val =
475426 inlineJS $ JSApp (JSIdent fun) $ map (inlineJS . jsSubst (JSIdent arg) opt) args
476427
477−inlineJS (JSApp fun args) =
478− JSApp (inlineJS fun) (map inlineJS args)
479−
480−inlineJS (JSNew con args) =
481− JSNew con $ map inlineJS args
482−
483−inlineJS (JSArray fields) =
484− JSArray (map inlineJS fields)
485−
486−inlineJS (JSAssign lhs rhs) =
487− JSAssign (inlineJS lhs) (inlineJS rhs)
488−
489−inlineJS (JSSeq seq) =
490− JSSeq (map inlineJS seq)
491−
492−inlineJS (JSFunction args body) =
493− JSFunction args (inlineJS body)
494−
495−inlineJS (JSProj (JSFunction args body) field) =
496− JSProj (JSFunction args (inlineJS body)) field
497−
498−inlineJS (JSReturn js) =
499− JSReturn $ inlineJS js
500−
501−inlineJS (JSAlloc name (Just js)) =
502− JSAlloc name (Just $ inlineJS js)
503−
504−inlineJS (JSCond cases) =
505− JSCond $ map (inlineJS *** inlineJS) cases
506−
507−inlineJS (JSOp op lhs rhs) =
508− JSOp op (inlineJS lhs) (inlineJS rhs)
509−
510−inlineJS (JSParens js) =
511− JSParens $ inlineJS js
512−
513−inlineJS js = js
428+inlineJS js = transformJS inlineJS js
514429
515430
516431reduceJS :: [JS] -> [JS]
@@ -633,50 +548,7 @@ initConstructors js =
633548 replaceHelper tags (JSNew "__IDRRT__Con" [JSNum (JSInt tag), JSArray []])
634549 | tag `elem` tags = JSIdent ("__IDRCTR__" ++ show tag)
635550
636− replaceHelper tags (JSNew con args) =
637− JSNew con $ map (replaceHelper tags) args
638−
639− replaceHelper tags (JSFunction fun body) =
640− JSFunction fun (replaceHelper tags body)
641−
642− replaceHelper tags (JSReturn ret) =
643− JSReturn (replaceHelper tags ret)
644−
645− replaceHelper tags (JSApp lhs rhs) =
646− JSApp (replaceHelper tags lhs) (map (replaceHelper tags) rhs)
647−
648− replaceHelper tags (JSSeq seq) =
649− JSSeq $ map (replaceHelper tags) seq
650−
651− replaceHelper tags (JSOp op lhs rhs) =
652− JSOp op (replaceHelper tags lhs) (replaceHelper tags rhs)
653−
654− replaceHelper tags (JSProj obj field) =
655− JSProj (replaceHelper tags obj) field
656−
657− replaceHelper tags (JSArray vals) =
658− JSArray $ map (replaceHelper tags) vals
659−
660− replaceHelper tags (JSAssign lhs rhs) =
661− JSAssign (replaceHelper tags lhs) (replaceHelper tags rhs)
662−
663− replaceHelper tags (JSAlloc var (Just val)) =
664− JSAlloc var $ Just (replaceHelper tags val)
665−
666− replaceHelper tags (JSCond conds) =
667− JSCond (map ((replaceHelper tags) *** (replaceHelper tags)) conds)
668−
669− replaceHelper tags (JSTernary c t f) =
670− JSTernary (replaceHelper tags c) (
671− replaceHelper tags t
672− ) (
673− replaceHelper tags f
674− )
675−
676− replaceHelper tags (JSParens js) =
677− JSParens $ replaceHelper tags js
678−
679− replaceHelper tags js = js
551+ replaceHelper tags js = transformJS (replaceHelper tags) js
680552
681553
682554 createConstant :: Int -> JS
@@ -720,40 +592,7 @@ removeIDs js =
720592 | Just pos <- lookup fun ids
721593 , pos < length args = args !! pos
722594
723− removeIDCall ids (JSAlloc fun (Just body)) =
724− JSAlloc fun (Just $ removeIDCall ids body)
725−
726− removeIDCall ids (JSReturn js) =
727− JSReturn $ removeIDCall ids js
728−
729− removeIDCall ids (JSSeq js) =
730− JSSeq $ map (removeIDCall ids) js
731−
732− removeIDCall ids (JSNew con args) =
733− JSNew con $ map (removeIDCall ids) args
734−
735− removeIDCall ids (JSFunction args body) =
736− JSFunction args $ removeIDCall ids body
737−
738− removeIDCall ids (JSApp fun args) =
739− JSApp (removeIDCall ids fun) $ map (removeIDCall ids) args
740−
741− removeIDCall ids (JSProj obj field) =
742− JSProj (removeIDCall ids obj) field
743−
744− removeIDCall ids (JSCond conds) =
745− JSCond $ map (removeIDCall ids *** removeIDCall ids) conds
746−
747− removeIDCall ids (JSAssign lhs rhs) =
748− JSAssign (removeIDCall ids lhs) (removeIDCall ids rhs)
749−
750− removeIDCall ids (JSArray fields) =
751− JSArray $ map (removeIDCall ids) fields
752−
753− removeIDCall ids (JSParens js) =
754− JSParens $ removeIDCall ids js
755−
756− removeIDCall _ js = js
595+ removeIDCall ids js = transformJS (removeIDCall ids) js
757596
758597
759598inlineFunctions :: [JS] -> [JS]
@@ -870,40 +709,7 @@ reduceConstant
870709reduceConstant (JSApp ident [(JSParens js)]) =
871710 JSApp ident [reduceConstant js]
872711
873−reduceConstant (JSOp op lhs rhs) =
874− JSOp op (reduceConstant lhs) (reduceConstant rhs)
875−
876−reduceConstant (JSReturn ret) =
877− JSReturn (reduceConstant ret)
878−
879−reduceConstant (JSApp fun args) =
880− JSApp (reduceConstant fun) (map reduceConstant args)
881−
882−reduceConstant (JSArray fields) =
883− JSArray (map reduceConstant fields)
884−
885−reduceConstant (JSAlloc name (Just val)) =
886− JSAlloc name $ Just (reduceConstant val)
887−
888−reduceConstant (JSNew con args) =
889− JSNew con (map reduceConstant args)
890−
891−reduceConstant (JSProj obj field) =
892− JSProj (reduceConstant obj) field
893−
894−reduceConstant (JSCond conds) =
895− JSCond $ map (reduceConstant *** reduceConstant) conds
896−
897−reduceConstant (JSSeq seq) =
898− JSSeq $ map reduceConstant seq
899−
900−reduceConstant (JSFunction args body) =
901− JSFunction args (reduceConstant body)
902−
903−reduceConstant (JSParens js) =
904− JSParens $ reduceConstant js
905−
906−reduceConstant js = js
712+reduceConstant js = transformJS reduceConstant js
907713
908714
909715reduceConstants :: JS -> JS
@@ -937,55 +743,7 @@ optimizeEvalTailcalls (fun, tc) js =
937743 ])
938744 | n == fun = JSApp (JSIdent tc) $ map optHelper args
939745
940− optHelper (JSFunction args body) =
941− JSFunction args $ optHelper body
942−
943− optHelper (JSSeq seq) =
944− JSSeq $ map optHelper seq
945−
946− optHelper (JSReturn ret) =
947− JSReturn $ optHelper ret
948−
949− optHelper (JSApp lhs rhs) =
950− JSApp (optHelper lhs) (map optHelper rhs)
951−
952− optHelper (JSNew con args) =
953− JSNew con $ map optHelper args
954−
955− optHelper (JSOp op lhs rhs) =
956− JSOp op (optHelper lhs) (optHelper rhs)
957−
958− optHelper (JSProj obj field) =
959− JSProj (optHelper obj) field
960−
961− optHelper (JSArray vals) =
962− JSArray $ map optHelper vals
963−
964− optHelper (JSAssign lhs rhs) =
965− JSAssign (optHelper lhs) (optHelper rhs)
966−
967− optHelper (JSAlloc var (Just val)) =
968− JSAlloc var (Just $ optHelper val)
969−
970− optHelper (JSIndex lhs rhs) =
971− JSIndex (optHelper lhs) (optHelper rhs)
972−
973− optHelper (JSCond conds) =
974− JSCond $ map (optHelper *** optHelper) conds
975−
976− optHelper (JSTernary c t f) =
977− JSTernary (
978− optHelper c
979− ) (
980− optHelper t
981− ) (
982− optHelper f
983− )
984−
985− optHelper (JSParens js) =
986− JSParens $ optHelper js
987−
988− optHelper js = js
746+ optHelper js = transformJS optHelper js
989747
990748
991749removeInstanceChecks :: JS -> JS
@@ -1005,53 +763,7 @@ removeInstanceChecks (JSCond conds) =
1005763 eliminateDeadBranches (x:xs) = x : eliminateDeadBranches xs
1006764 eliminateDeadBranches [] = []
1007765
1008−
1009−removeInstanceChecks (JSFunction args body) =
1010− JSFunction args $ removeInstanceChecks body
1011−
1012−removeInstanceChecks (JSSeq seq) =
1013− JSSeq $ map removeInstanceChecks seq
1014−
1015−removeInstanceChecks (JSReturn ret) =
1016− JSReturn $ removeInstanceChecks ret
1017−
1018−removeInstanceChecks (JSApp lhs rhs) =
1019− JSApp (removeInstanceChecks lhs) $ map removeInstanceChecks rhs
1020−
1021−removeInstanceChecks (JSNew con args) =
1022− JSNew con $ map removeInstanceChecks args
1023−
1024−removeInstanceChecks (JSOp op lhs rhs) =
1025− JSOp op (removeInstanceChecks lhs) (removeInstanceChecks rhs)
1026−
1027−removeInstanceChecks (JSProj obj field) =
1028− JSProj (removeInstanceChecks obj) field
1029−
1030−removeInstanceChecks (JSArray vals) =
1031− JSArray $ map removeInstanceChecks vals
1032−
1033−removeInstanceChecks (JSAssign lhs rhs) =
1034− JSAssign (removeInstanceChecks lhs) (removeInstanceChecks rhs)
1035−
1036−removeInstanceChecks (JSAlloc var (Just val)) =
1037− JSAlloc var (Just $ removeInstanceChecks val)
1038−
1039−removeInstanceChecks (JSIndex lhs rhs) =
1040− JSIndex (removeInstanceChecks lhs) (removeInstanceChecks rhs)
1041−
1042−removeInstanceChecks (JSTernary c t f) =
1043− JSTernary (
1044− removeInstanceChecks c
1045− ) (
1046− removeInstanceChecks t
1047− ) (
1048− removeInstanceChecks f
1049− )
1050−
1051−removeInstanceChecks (JSParens js) =
1052− JSParens $ removeInstanceChecks js
1053−
1054−removeInstanceChecks js = js
766+removeInstanceChecks js = transformJS removeInstanceChecks js
1055767
1056768
1057769reduceLoop :: [String] -> ([JS], [JS]) -> [JS]
@@ -1094,46 +806,7 @@ reduceLoop reduced (cons, program) =
1094806 reduceCall funs js@(JSApp id@(JSIdent fun) _)
1095807 | fun `elem` funs = id
1096808
1097− reduceCall funs (JSAlloc fun (Just body)) =
1098− JSAlloc fun (Just $ reduceCall funs body)
1099−
1100− reduceCall funs (JSReturn js) =
1101− JSReturn $ reduceCall funs js
1102−
1103− reduceCall funs (JSSeq js) =
1104− JSSeq $ map (reduceCall funs) js
1105−
1106− reduceCall funs (JSNew con args) =
1107− JSNew con $ map (reduceCall funs) args
1108−
1109− reduceCall funs (JSFunction args body) =
1110− JSFunction args $ reduceCall funs body
1111−
1112− reduceCall funs (JSApp fun args) =
1113− JSApp (reduceCall funs fun) $ map (reduceCall funs) args
1114−
1115− reduceCall funs (JSProj obj field) =
1116− JSProj (reduceCall funs obj) field
1117−
1118− reduceCall funs (JSIndex obj idx) =
1119− JSIndex (reduceCall funs obj) (reduceCall funs idx)
1120−
1121− reduceCall funs (JSOp op rhs lhs) =
1122− JSOp op (reduceCall funs rhs) (reduceCall funs lhs)
1123−
1124− reduceCall funs (JSCond conds) =
1125− JSCond $ map (reduceCall funs *** reduceCall funs) conds
1126−
1127− reduceCall funs (JSAssign lhs rhs) =
1128− JSAssign (reduceCall funs lhs) (reduceCall funs rhs)
1129−
1130− reduceCall funs (JSArray fields) =
1131− JSArray $ map (reduceCall funs) fields
1132−
1133− reduceCall funs (JSParens js) =
1134− JSParens $ reduceCall funs js
1135−
1136− reduceCall _ js = js
809+ reduceCall funs js = transformJS (reduceCall funs) js
1137810
1138811
1139812optimizeJS :: JS -> JS