@@ -771,6 +771,70 @@ optimizeEvalTailcalls (fun, tc) js =
771771 optHelper js = transformJS optHelper js
772772
773773
774+unfoldLookupTable :: [JS] -> [JS]
775+unfoldLookupTable input =
776+ let (evals, evalunfold) = unfoldLT "__IDRLT__mEVAL0" input
777+ (applys, applyunfold) = unfoldLT "__IDRLT__mAPPLY0" evalunfold
778+ js = applyunfold in expandCons evals applys js
779+ where
780+ unfoldLT :: String -> [JS] -> ([Int], [JS])
781+ unfoldLT lt js =
782+ let (table, code) = extractLT lt js
783+ expanded = expandLT lt table in
784+ (map fst expanded, map snd expanded ++ code)
785+
786+
787+ expandCons :: [Int] -> [Int] -> [JS] -> [JS]
788+ expandCons evals applys js =
789+ map expandCons' js
790+ where
791+ expandCons' :: JS -> JS
792+ expandCons' (JSNew "__IDRRT__Con" [JSNum (JSInt tag), JSArray args])
793+ | evalid <- getId "__IDRLT__mEVAL0" tag evals
794+ , applyid <- getId "__IDRLT__mAPPLY0" tag applys =
795+ JSNew "__IDRRT__Con" [ JSNum (JSInt tag)
796+ , maybe JSNull JSIdent evalid
797+ , maybe JSNull JSIdent applyid
798+ , JSArray (map expandCons' args)
799+ ]
800+
801+ expandCons' js = transformJS expandCons' js
802+
803+
804+ getId :: String -> Int -> [Int] -> Maybe String
805+ getId lt tag entries
806+ | tag `elem` entries = Just $ ltIdentifier lt tag
807+ | otherwise = Nothing
808+
809+
810+ ltIdentifier :: String -> Int -> String
811+ ltIdentifier "__IDRLT__mEVAL0" id = idrLTNamespace ++ "EVAL" ++ show id
812+ ltIdentifier "__IDRLT__mAPPLY0" id = idrLTNamespace ++ "APPLY" ++ show id
813+
814+
815+ extractLT :: String -> [JS] -> (JS, [JS])
816+ extractLT lt js =
817+ extractLT' ([], js)
818+ where
819+ extractLT' :: ([JS], [JS]) -> (JS, [JS])
820+ extractLT' (front, js@(JSAlloc fun _):back)
821+ | fun == lt = (js, front ++ back)
822+
823+ extractLT' (front, js:back) = extractLT' (front ++ [js], back)
824+
825+
826+ expandLT :: String -> JS -> [(Int, JS)]
827+ expandLT lt (
828+ JSAlloc _ (Just (JSApp (JSFunction [] (JSSeq seq)) []))
829+ ) = catMaybes (map expandEntry seq)
830+ where
831+ expandEntry :: JS -> Maybe (Int, JS)
832+ expandEntry (JSAssign (JSIndex _ (JSNum (JSInt id))) body) =
833+ Just $ (id, JSAlloc (ltIdentifier lt id) (Just body))
834+
835+ expandEntry js = Nothing
836+
837+
774838removeInstanceChecks :: JS -> JS
775839removeInstanceChecks (JSCond conds) =
776840 JSCond $ eliminateDeadBranches $ map (
@@ -900,6 +964,7 @@ codegenJavaScript target definitions filename outputType = do
900964 , map removeInstanceChecks
901965 , inlineFunctions
902966 , map reduceContinuations
967+ , unfoldLookupTable
903968 ]
904969
905970 prelude :: [JS]