@@ -407,8 +407,8 @@ removeAllocations (JSSeq body) =
407407removeAllocations js = transformJS removeAllocations js
408408
409409
410−isJSConstant :: JS -> Bool
411−isJSConstant js
410+isJSConstant :: [String] -> JS -> Bool
411+isJSConstant constants js
412412 | JSString _ <- js = True
413413 | JSChar _ <- js = True
414414 | JSNum _ <- js = True
@@ -416,6 +416,13 @@ isJSConstant js
416416 | JSNull <- js = True
417417
418418 | JSApp (JSIdent "__IDRRT__bigInt") _ <- js = True
419+
420+ | JSArray vals <- js = all (isJSConstant constants) vals
421+ | JSNew "__IDRRT__Con" args <- js = all (isJSConstant constants) args
422+
423+ | JSIdent name <- js
424+ , name `elem` constants = True
425+
419426 | otherwise = False
420427
421428
@@ -443,12 +450,12 @@ inlineJS (JSApp (JSProj (JSFunction args (JSReturn body)) "apply") [
443450 ) (n + 1)
444451
445452inlineJS (JSApp (JSIdent "__IDR__mEVAL0") [val])
446− | isJSConstant val = val
453+ | isJSConstant [] val = val
447454
448455inlineJS (JSApp (JSIdent "__IDRRT__tailcall") [
449456 JSFunction [] (JSReturn val)
450457 ])
451− | isJSConstant val = val
458+ | isJSConstant [] val = val
452459
453460inlineJS (JSApp (JSFunction [arg] (JSReturn ret)) [val])
454461 | JSNew con [tag, vals] <- ret
@@ -1000,6 +1007,59 @@ optimizeJS = inlineLoop
10001007 | otherwise = js
10011008
10021009
1010+extractLocalConstructors :: [JS] -> [JS]
1011+extractLocalConstructors js =
1012+ concatMap extractLocalConstructors' js
1013+ where
1014+ globalCons :: [String]
1015+ globalCons = concatMap (getGlobalCons) js
1016+
1017+
1018+ extractLocalConstructors' :: JS -> [JS]
1019+ extractLocalConstructors' js@(JSAlloc fun (Just (JSFunction args body))) =
1020+ map allocCon cons ++ [foldr (uncurry jsSubst) js (reverse cons)]
1021+ where
1022+ cons :: [(JS, JS)]
1023+ cons = zipWith genName (foldJS match (++) [] body) [1..]
1024+ where
1025+ genName :: JS -> Int -> (JS, JS)
1026+ genName js id =
1027+ (js, JSIdent $ idrCTRNamespace ++ fun ++ "_" ++ show id)
1028+
1029+ match :: JS -> [JS]
1030+ match js
1031+ | JSNew "__IDRRT__Con" args <- js
1032+ , all isConstant args = [js]
1033+ | otherwise = []
1034+
1035+
1036+ allocCon :: (JS, JS) -> JS
1037+ allocCon (js, JSIdent name) =
1038+ JSAlloc name (Just js)
1039+
1040+
1041+ isConstant :: JS -> Bool
1042+ isConstant js
1043+ | JSNew "__IDRRT__Con" args <- js
1044+ , all isConstant args =
1045+ True
1046+ | otherwise =
1047+ isJSConstant globalCons js
1048+
1049+ extractLocalConstructors' js = [js]
1050+
1051+
1052+ getGlobalCons :: JS -> [String]
1053+ getGlobalCons js = foldJS match (++) [] js
1054+ where
1055+ match :: JS -> [String]
1056+ match js
1057+ | (JSAlloc name (Just (JSNew "__IDRRT__Con" _))) <- js =
1058+ [name]
1059+ | otherwise =
1060+ []
1061+
1062+
10031063codegenJavaScript
10041064 :: JSTarget
10051065 -> [(Name, SDecl)]
@@ -1056,6 +1116,7 @@ codegenJavaScript target definitions filename outputType = do
10561116 , map removeInstanceChecks
10571117 , inlineFunctions
10581118 , map reduceContinuations
1119+ , extractLocalConstructors
10591120 , unfoldLookupTable
10601121 ]
10611122