@@ -839,8 +839,47 @@ unfoldLookupTable :: [JS] -> [JS]
839839unfoldLookupTable input =
840840 let (evals, evalunfold) = unfoldLT "__IDRLT__mEVAL0" input
841841 (applys, applyunfold) = unfoldLT "__IDRLT__mAPPLY0" evalunfold
842− js = applyunfold in expandCons evals applys js
842+ js = applyunfold in
843+ adaptRuntime $ expandCons evals applys js
843844 where
845+ adaptRuntime :: [JS] -> [JS]
846+ adaptRuntime =
847+ adaptCon . adaptApply "__var_2" . adaptApply "ev" . adaptEval
848+
849+
850+ adaptApply var = map (jsSubst (
851+ JSIndex (JSIdent "__IDRLT__mAPPLY0") (JSProj (JSIdent var) "tag")
852+ ) (JSProj (JSIdent var) "app"))
853+
854+
855+ adaptEval = map (jsSubst (
856+ JSIndex (JSIdent "__IDRLT__mEVAL0") (JSProj (JSIdent "arg0") "tag")
857+ ) (JSProj (JSIdent "arg0") "eval"))
858+
859+
860+ adaptCon js =
861+ adaptCon' [] js
862+ where
863+ adaptCon' front ((JSAlloc "__IDRRT__Con" (Just body)):back) =
864+ front ++ (new:back)
865+
866+ adaptCon' front (next:back) =
867+ adaptCon' (front ++ [next]) back
868+
869+ adaptCon' front [] = front
870+
871+
872+ new =
873+ JSAlloc "__IDRRT__Con" (Just $
874+ JSFunction newArgs (
875+ JSSeq (map newVar newArgs)
876+ )
877+ )
878+ where
879+ newVar var = JSAssign (JSProj JSThis var) (JSIdent var)
880+ newArgs = ["tag", "eval", "app", "vars"]
881+
882+
844883 unfoldLT :: String -> [JS] -> ([Int], [JS])
845884 unfoldLT lt js =
846885 let (table, code) = extractLT lt js
@@ -1184,8 +1223,10 @@ translateDeclaration (path, SFun name params stackSize body)
11841223 , (SLet var val next) <- body
11851224 , (SChkCase cvar cases) <- next
11861225 , ap == txt "APPLY" =
1187− let lvar = translateVariableName var
1188− lookup = "[" ++ lvar ++ ".tag](fn0,arg0," ++ lvar ++ ")" in
1226+ let lvar = translateVariableName var
1227+ lookup t = (JSApp
1228+ (JSIndex (JSIdent t) (JSProj (JSIdent lvar) "tag"))
1229+ [JSIdent "fn0", JSIdent "arg0", JSIdent lvar]) in
11891230 [ lookupTable [(var, "chk")] var cases
11901231 , jsDecl $ JSFunction ["fn0", "arg0"] (
11911232 JSSeq [ JSAlloc "__var_0" (Just $ JSIdent "fn0")
@@ -1195,10 +1236,7 @@ translateDeclaration (path, SFun name params stackSize body)
11951236 , JSReturn $ (JSTernary (
11961237 (JSVar var `jsInstanceOf` jsCon) `jsAnd`
11971238 (hasProp lookupTableName (translateVariableName var))
1198− ) (JSIdent $
1199− lookupTableName ++ lookup
1200− ) JSNull
1201− )
1239+ ) (lookup lookupTableName) JSNull)
12021240 ]
12031241 )
12041242 ]