@@ -197,6 +197,14 @@ jsBigInt val =
197197jsVar :: Int -> String
198198jsVar = ("__var_" ++) . show
199199
200+jsLet :: String -> JS -> JS -> JS
201+jsLet name value body =
202+ JSApp (
203+ JSFunction [name] (
204+ JSReturn body
205+ )
206+ ) [value]
207+
200208codegenJavaScript
201209 :: JSTarget
202210 -> [(Name, SDecl)]
@@ -326,20 +334,34 @@ translateDeclaration (path, SFun name params stackSize body)
326334 , (SLet var val next) <- body
327335 , (SChkCase cvar cases) <- next =
328336 let fun = translateExpression body in
329− jsDecl $ jsFun fun
330− | (MN _ "EVAL") <- name
331− , (SChkCase var cases) <- body =
332− let fun = translateExpression body in
333− JSSeq [ lookupTable var cases
334− , jsDecl $ JSFunction ["arg0"] (JSRaw $
335− concat [ "if (arg0 instanceof __IDRRT__Con "
336− , " && " ++ lookupTableName ++ ".hasOwnProperty(arg0.tag))"
337− , "return " ++ lookupTableName ++ "[arg0.tag](arg0);"
338− , "else "
339− , "return arg0;"
340− ]
337+ {-jsDecl $ jsFun fun-}
338+ JSSeq [ lookupTable Nothing var cases
339+ , jsDecl $ JSFunction ["fn0", "arg0"] (
340+ JSSeq [ JSRaw "var __var_0 = fn0"
341+ , jsLet (translateVariableName var) (
342+ translateExpression val
343+ ) (JSRaw $
344+ concat [ "(" ++ translateVariableName var ++ " instanceof __IDRRT__Con "
345+ , " && " ++ lookupTableName ++ ".hasOwnProperty(" ++ translateVariableName var ++ ".tag)) ? "
346+ , lookupTableName ++ "[" ++ translateVariableName var ++ ".tag](fn0,arg0," ++ translateVariableName var ++ ") : null;"
347+ ]
348+ )
349+ ]
341350 )
342351 ]
352+
353+ | (MN _ "EVAL") <- name
354+ , (SChkCase var cases) <- body =
355+ JSSeq [ lookupTable Nothing var cases
356+ , jsDecl $ JSFunction ["arg0"] (JSRaw $
357+ concat [ "if (arg0 instanceof __IDRRT__Con "
358+ , " && " ++ lookupTableName ++ ".hasOwnProperty(arg0.tag))"
359+ , "return " ++ lookupTableName ++ "[arg0.tag](arg0);"
360+ , "else "
361+ , "return arg0;"
362+ ]
363+ )
364+ ]
343365 | otherwise =
344366 let fun = translateExpression body in
345367 jsDecl $ jsFun fun
@@ -356,8 +378,8 @@ translateDeclaration (path, SFun name params stackSize body)
356378 lookupTableName :: String
357379 lookupTableName = idrLTNamespace ++ translateName name
358380
359− lookupTable :: LVar -> [SAlt] -> JS
360− lookupTable var cases =
381+ lookupTable :: Maybe (String, String) -> LVar -> [SAlt] -> JS
382+ lookupTable m var cases =
361383 JSAlloc lookupTableName $ Just (
362384 JSObject $ catMaybes $ map (lookupEntry var) cases
363385 )
@@ -397,11 +419,14 @@ translateVariableName (Loc i) =
397419
398420translateExpression :: SExp -> JS
399421translateExpression (SLet name value body) =
400− JSApp (
401− JSFunction [translateVariableName name] (
402− JSReturn $ translateExpression body
403− )
404− ) [translateExpression value]
422+ jsLet (translateVariableName name) (
423+ translateExpression value
424+ ) (translateExpression body)
425+ {-JSApp (-}
426+ {-JSFunction [translateVariableName name] (-}
427+ {-JSReturn $ translateExpression body-}
428+ {-)-}
429+ {-) [translateExpression value]-}
405430
406431translateExpression (SConst cst) =
407432 translateConstant cst