on master help sign in
javascript: refactor eval generation
fa70338raichoo
src/IRTS/CodegenJavaScript.hs+19−15
@@ -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)]
63+ | JSTernary JS JS JS
63
64
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}"
158
159
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+
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
199
206
200jsLet :: String -> JS -> JS -> JS
207jsLet :: String -> JS -> JS -> JS
201−jsLet name value body =
208+jsLet name value body =
202 JSApp (
209 JSApp (
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)
348 ]
355 ]
349 )
356 )
350 ]
357 ]
351−
358+
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")
359− , "else "
360− , "return arg0;"
361− ]
362 )
367 )
363 ]
368 ]
364 | otherwise =
369 | otherwise =
@@ -366,6 +371,10 @@ translateDeclaration (path, SFun name params stackSize body)
366 jsDecl $ jsFun fun
371 jsDecl $ jsFun fun
367
372
368 where
373 where
374+ hasProp :: String -> String -> JS
375+ hasProp table var =
376+ jsMeth (JSRaw table) "hasOwnProperty" [JSRaw $ var ++ ".tag"]
377+
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)
430− {-JSApp (-}
431− {-JSFunction [translateVariableName name] (-}
432− {-JSReturn $ translateExpression body-}
433− {-)-}
434− {-) [translateExpression value]-}
435
439
436translateExpression (SConst cst) =
440translateExpression (SConst cst) =
437 translateConstant cst
441 translateConstant cst