@@ -60,6 +60,7 @@ data JS = JSRaw String
60 | JSAlloc String (Maybe JS)
60 | JSAlloc String (Maybe JS)
61 | JSIndex JS JS
61 | JSIndex JS JS
62 | JSCond [(JS, JS)]
62 | JSCond [(JS, JS)]
64compileJS :: JS -> String
65compileJS :: JS -> String
65compileJS (JSRaw code) =
66compileJS (JSRaw code) =
@@ -156,6 +157,12 @@ compileJS (JSCond branches) =
156 ++ "return " ++ compileJS e
157 ++ "return " ++ compileJS e
157 ++ ";\n}"
158 ++ ";\n}"
160+compileJS (JSTernary cond true false) =
161+ let c = compileJS cond
163+ f = compileJS false in
164+ "(" ++ c ++ ")?(" ++ t ++ "):(" ++ f ++ ")"
159jsTailcall :: JS -> JS
166jsTailcall :: JS -> JS
160jsTailcall call =
167jsTailcall call =
161 jsCall (idrRTNamespace ++ "tailcall") [
168 jsCall (idrRTNamespace ++ "tailcall") [
@@ -198,7 +205,7 @@ jsVar :: Int -> String
198jsVar = ("__var_" ++) . show
205jsVar = ("__var_" ++) . show
200jsLet :: String -> JS -> JS -> JS
207jsLet :: String -> JS -> JS -> JS
201−jsLet name value body =
208+jsLet name value body =
203 JSFunction [name] (
210 JSFunction [name] (
204 JSReturn body
211 JSReturn body
@@ -336,7 +343,7 @@ translateDeclaration (path, SFun name params stackSize body)
336 let fun = translateExpression body in
343 let fun = translateExpression body in
337 JSSeq [ lookupTable [(var, "chk")] var cases
344 JSSeq [ lookupTable [(var, "chk")] var cases
338 , jsDecl $ JSFunction ["fn0", "arg0"] (
345 , jsDecl $ JSFunction ["fn0", "arg0"] (
339− JSSeq [ JSRaw "var __var_0 = fn0"
346+ JSSeq [ JSAlloc "__var_0" (Just $ JSRaw "fn0")
340 , JSReturn $ jsLet (translateVariableName var) (
347 , JSReturn $ jsLet (translateVariableName var) (
341 translateExpression val
348 translateExpression val
342 ) (JSRaw $
349 ) (JSRaw $
@@ -348,17 +355,15 @@ translateDeclaration (path, SFun name params stackSize body)
352 | (MN _ "EVAL") <- name
359 | (MN _ "EVAL") <- name
353 , (SChkCase var cases) <- body =
360 , (SChkCase var cases) <- body =
354 JSSeq [ lookupTable [] var cases
361 JSSeq [ lookupTable [] var cases
355− , jsDecl $ JSFunction ["arg0"] (JSRaw $
362+ , jsDecl $ JSFunction ["arg0"] (JSReturn $
356− concat [ "if (arg0 instanceof __IDRRT__Con "
363+ JSTernary (
364+ (JSRaw "arg0" `jsInstanceOf` jsCon) `jsAnd`
357− , " && " ++ lookupTableName ++ ".hasOwnProperty(arg0.tag))"
365+ (hasProp lookupTableName "arg0")
358− , "return " ++ lookupTableName ++ "[arg0.tag](arg0);"
366+ ) (JSRaw $ lookupTableName ++ "[arg0.tag](arg0)") (JSRaw "arg0")
364 | otherwise =
369 | otherwise =
@@ -366,6 +371,10 @@ translateDeclaration (path, SFun name params stackSize body)
366 jsDecl $ jsFun fun
371 jsDecl $ jsFun fun
374+ hasProp :: String -> String -> JS
376+ jsMeth (JSRaw table) "hasOwnProperty" [JSRaw $ var ++ ".tag"]
369 caseFun :: [(LVar, String)] -> LVar -> SAlt -> JS
378 caseFun :: [(LVar, String)] -> LVar -> SAlt -> JS
370 caseFun aux var cse =
379 caseFun aux var cse =
371 jsFunAux aux (translateCase (Just (translateVariableName var)) cse)
380 jsFunAux aux (translateCase (Just (translateVariableName var)) cse)
@@ -427,11 +436,6 @@ translateExpression (SLet name value body) =
427 jsLet (translateVariableName name) (
436 jsLet (translateVariableName name) (
428 translateExpression value
437 translateExpression value
429 ) (translateExpression body)
438 ) (translateExpression body)
431− {-JSFunction [translateVariableName name] (-}
432− {-JSReturn $ translateExpression body-}
434− {-) [translateExpression value]-}
436translateExpression (SConst cst) =
440translateExpression (SConst cst) =
437 translateConstant cst
441 translateConstant cst