@@ -60,6 +60,7 @@ data JS = JSRaw String
6060 | JSAlloc String (Maybe JS)
6161 | JSIndex JS JS
6262 | JSCond [(JS, JS)]
63+ | JSTernary JS JS JS
6364
6465compileJS :: JS -> String
6566compileJS (JSRaw code) =
@@ -156,6 +157,12 @@ compileJS (JSCond branches) =
156157 ++ "return " ++ compileJS e
157158 ++ ";\n}"
158159
160+compileJS (JSTernary cond true false) =
161+ let c = compileJS cond
162+ t = compileJS true
163+ f = compileJS false in
164+ "(" ++ c ++ ")?(" ++ t ++ "):(" ++ f ++ ")"
165+
159166jsTailcall :: JS -> JS
160167jsTailcall call =
161168 jsCall (idrRTNamespace ++ "tailcall") [
@@ -198,7 +205,7 @@ jsVar :: Int -> String
198205jsVar = ("__var_" ++) . show
199206
200207jsLet :: String -> JS -> JS -> JS
201−jsLet name value body =
208+jsLet name value body =
202209 JSApp (
203210 JSFunction [name] (
204211 JSReturn body
@@ -336,7 +343,7 @@ translateDeclaration (path, SFun name params stackSize body)
336343 let fun = translateExpression body in
337344 JSSeq [ lookupTable [(var, "chk")] var cases
338345 , jsDecl $ JSFunction ["fn0", "arg0"] (
339− JSSeq [ JSRaw "var __var_0 = fn0"
346+ JSSeq [ JSAlloc "__var_0" (Just $ JSRaw "fn0")
340347 , JSReturn $ jsLet (translateVariableName var) (
341348 translateExpression val
342349 ) (JSRaw $
@@ -348,17 +355,15 @@ translateDeclaration (path, SFun name params stackSize body)
348355 ]
349356 )
350357 ]
351−
358+
352359 | (MN _ "EVAL") <- name
353360 , (SChkCase var cases) <- body =
354361 JSSeq [ lookupTable [] var cases
355− , jsDecl $ JSFunction ["arg0"] (JSRaw $
356− concat [ "if (arg0 instanceof __IDRRT__Con "
357− , " && " ++ lookupTableName ++ ".hasOwnProperty(arg0.tag))"
358− , "return " ++ lookupTableName ++ "[arg0.tag](arg0);"
359− , "else "
360− , "return arg0;"
361− ]
362+ , jsDecl $ JSFunction ["arg0"] (JSReturn $
363+ JSTernary (
364+ (JSRaw "arg0" `jsInstanceOf` jsCon) `jsAnd`
365+ (hasProp lookupTableName "arg0")
366+ ) (JSRaw $ lookupTableName ++ "[arg0.tag](arg0)") (JSRaw "arg0")
362367 )
363368 ]
364369 | otherwise =
@@ -366,6 +371,10 @@ translateDeclaration (path, SFun name params stackSize body)
366371 jsDecl $ jsFun fun
367372
368373 where
374+ hasProp :: String -> String -> JS
375+ hasProp table var =
376+ jsMeth (JSRaw table) "hasOwnProperty" [JSRaw $ var ++ ".tag"]
377+
369378 caseFun :: [(LVar, String)] -> LVar -> SAlt -> JS
370379 caseFun aux var cse =
371380 jsFunAux aux (translateCase (Just (translateVariableName var)) cse)
@@ -427,11 +436,6 @@ translateExpression (SLet name value body) =
427436 jsLet (translateVariableName name) (
428437 translateExpression value
429438 ) (translateExpression body)
430− {-JSApp (-}
431− {-JSFunction [translateVariableName name] (-}
432− {-JSReturn $ translateExpression body-}
433− {-)-}
434− {-) [translateExpression value]-}
435439
436440translateExpression (SConst cst) =
437441 translateConstant cst