@@ -438,6 +438,96 @@ reduceJS js = reduceLoop [] ([], js)
438438funName :: JS -> String
439439funName (JSAlloc fun _) = fun
440440
441+initConstructors :: [JS] -> [JS]
442+initConstructors js =
443+ let tags = nub $ sort $ concat (map getTags js) in
444+ map createConstant tags ++ replaceConstructors tags js
445+ where
446+ getTags :: JS -> [Int]
447+ getTags (JSNew "__IDRRT__Con" [JSNum (JSInt tag), JSArray []]) = [tag]
448+
449+ getTags (JSNew _ args) = concatMap getTags args
450+
451+ getTags (JSFunction _ body) = getTags body
452+
453+ getTags (JSReturn ret) = getTags ret
454+
455+ getTags (JSApp lhs rhs) = getTags lhs ++ concatMap getTags rhs
456+
457+ getTags (JSSeq seq) = concatMap getTags seq
458+
459+ getTags (JSOp _ lhs rhs) = getTags lhs ++ getTags rhs
460+
461+ getTags (JSProj obj _) = getTags obj
462+
463+ getTags (JSArray vals) = concatMap getTags vals
464+
465+ getTags (JSAssign lhs rhs) = getTags lhs ++ getTags rhs
466+
467+ getTags (JSAlloc _ (Just val)) = getTags val
468+
469+ getTags (JSCond conds) =
470+ concatMap (uncurry (++)) $ map (getTags *** getTags) conds
471+
472+ getTags (JSTernary c t f) = getTags c ++ getTags t ++ getTags f
473+
474+ getTags js = []
475+
476+ replaceConstructors :: [Int] -> [JS] -> [JS]
477+ replaceConstructors tags js = map (replaceHelper tags) js
478+ where
479+ replaceHelper :: [Int] -> JS -> JS
480+ replaceHelper tags (JSNew "__IDRRT__Con" [JSNum (JSInt tag), JSArray []])
481+ | tag `elem` tags = JSIdent ("__IDRCTR__" ++ show tag)
482+
483+ replaceHelper tags (JSNew con args) =
484+ JSNew con $ map (replaceHelper tags) args
485+
486+ replaceHelper tags (JSFunction fun body) =
487+ JSFunction fun (replaceHelper tags body)
488+
489+ replaceHelper tags (JSReturn ret) =
490+ JSReturn (replaceHelper tags ret)
491+
492+ replaceHelper tags (JSApp lhs rhs) =
493+ JSApp (replaceHelper tags lhs) (map (replaceHelper tags) rhs)
494+
495+ replaceHelper tags (JSSeq seq) =
496+ JSSeq $ map (replaceHelper tags) seq
497+
498+ replaceHelper tags (JSOp op lhs rhs) =
499+ JSOp op (replaceHelper tags lhs) (replaceHelper tags rhs)
500+
501+ replaceHelper tags (JSProj obj field) =
502+ JSProj (replaceHelper tags obj) field
503+
504+ replaceHelper tags (JSArray vals) =
505+ JSArray $ map (replaceHelper tags) vals
506+
507+ replaceHelper tags (JSAssign lhs rhs) =
508+ JSAssign (replaceHelper tags lhs) (replaceHelper tags rhs)
509+
510+ replaceHelper tags (JSAlloc var (Just val)) =
511+ JSAlloc var $ Just (replaceHelper tags val)
512+
513+ replaceHelper tags (JSCond conds) =
514+ JSCond (map ((replaceHelper tags) *** (replaceHelper tags)) conds)
515+
516+ replaceHelper tags (JSTernary c t f) =
517+ JSTernary (replaceHelper tags c) (
518+ replaceHelper tags t
519+ ) (
520+ replaceHelper tags f
521+ )
522+
523+ replaceHelper tags js = js
524+
525+ createConstant :: Int -> JS
526+ createConstant tag =
527+ JSAlloc ("__IDRCTR__" ++ show tag) (Just (
528+ JSNew (idrRTNamespace ++ "Con") [JSNum (JSInt tag), JSArray []]
529+ ))
530+
441531removeIDs :: [JS] -> [JS]
442532removeIDs js =
443533 case partition isID js of
@@ -659,7 +749,7 @@ codegenJavaScript target definitions filename outputType = do
659749
660750 functions :: [String]
661751 functions =
662− map (compileJS . reduceConstants) ((reduceJS . removeIDs) $ map (optimizeJS . translateDeclaration) def)
752+ map compileJS $ initConstructors (map reduceConstants ((reduceJS . removeIDs) $ map (optimizeJS . translateDeclaration) def))
663753
664754 mainLoop :: String
665755 mainLoop = compileJS $