git.iko.soy/Idris-dev
on master help sign in
javascript: apply lookuptable
feafcearaichoo
src/IRTS/CodegenJavaScript.hs+44−19
compare with master
unifiedsplit
@@ -197,6 +197,14 @@ jsBigInt val =
197jsVar :: Int -> String
197jsVar :: Int -> String
198jsVar = ("__var_" ++) . show
198jsVar = ("__var_" ++) . show
199
199
200+jsLet :: String -> JS -> JS -> JS
201+jsLet name value body =
202+ JSApp (
203+ JSFunction [name] (
204+ JSReturn body
205+ )
206+ ) [value]
207+
200codegenJavaScript
208codegenJavaScript
201 :: JSTarget
209 :: JSTarget
202 -> [(Name, SDecl)]
210 -> [(Name, SDecl)]
@@ -326,20 +334,34 @@ translateDeclaration (path, SFun name params stackSize body)
326 , (SLet var val next) <- body
334 , (SLet var val next) <- body
327 , (SChkCase cvar cases) <- next =
335 , (SChkCase cvar cases) <- next =
328 let fun = translateExpression body in
336 let fun = translateExpression body in
329− jsDecl $ jsFun fun
337+ {-jsDecl $ jsFun fun-}
330− | (MN _ "EVAL") <- name
331− , (SChkCase var cases) <- body =
332− let fun = translateExpression body in
333− JSSeq [ lookupTable var cases
338+ JSSeq [ lookupTable Nothing var cases
334− , jsDecl $ JSFunction ["arg0"] (JSRaw $
339+ , jsDecl $ JSFunction ["fn0", "arg0"] (
340+ JSSeq [ JSRaw "var __var_0 = fn0"
341+ , jsLet (translateVariableName var) (
342+ translateExpression val
343+ ) (JSRaw $
335− concat [ "if (arg0 instanceof __IDRRT__Con "
344+ concat [ "(" ++ translateVariableName var ++ " instanceof __IDRRT__Con "
336− , " && " ++ lookupTableName ++ ".hasOwnProperty(arg0.tag))"
345+ , " && " ++ lookupTableName ++ ".hasOwnProperty(" ++ translateVariableName var ++ ".tag)) ? "
337− , "return " ++ lookupTableName ++ "[arg0.tag](arg0);"
346+ , lookupTableName ++ "[" ++ translateVariableName var ++ ".tag](fn0,arg0," ++ translateVariableName var ++ ") : null;"
338− , "else "
347+ ]
339− , "return arg0;"
348+ )
340− ]
349+ ]
341 )
350 )
342 ]
351 ]
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+ ]
343 | otherwise =
365 | otherwise =
344 let fun = translateExpression body in
366 let fun = translateExpression body in
345 jsDecl $ jsFun fun
367 jsDecl $ jsFun fun
@@ -356,8 +378,8 @@ translateDeclaration (path, SFun name params stackSize body)
356 lookupTableName :: String
378 lookupTableName :: String
357 lookupTableName = idrLTNamespace ++ translateName name
379 lookupTableName = idrLTNamespace ++ translateName name
358
380
359− lookupTable :: LVar -> [SAlt] -> JS
381+ lookupTable :: Maybe (String, String) -> LVar -> [SAlt] -> JS
360− lookupTable var cases =
382+ lookupTable m var cases =
361 JSAlloc lookupTableName $ Just (
383 JSAlloc lookupTableName $ Just (
362 JSObject $ catMaybes $ map (lookupEntry var) cases
384 JSObject $ catMaybes $ map (lookupEntry var) cases
363 )
385 )
@@ -397,11 +419,14 @@ translateVariableName (Loc i) =
397
419
398translateExpression :: SExp -> JS
420translateExpression :: SExp -> JS
399translateExpression (SLet name value body) =
421translateExpression (SLet name value body) =
422+ jsLet (translateVariableName name) (
423+ translateExpression value
424+ ) (translateExpression body)
400− JSApp (
425+ {-JSApp (-}
401− JSFunction [translateVariableName name] (
426+ {-JSFunction [translateVariableName name] (-}
402− JSReturn $ translateExpression body
427+ {-JSReturn $ translateExpression body-}
403− )
428+ {-)-}
404− ) [translateExpression value]
429+ {-) [translateExpression value]-}
405
430
406translateExpression (SConst cst) =
431translateExpression (SConst cst) =
407 translateConstant cst
432 translateConstant cst