git.iko.soy/Idris-dev
on master help sign in
javascript: reduce more functions
dd10071raichoo
src/IRTS/CodegenJavaScript.hs+15−13
compare with master
unifiedsplit
@@ -338,7 +338,7 @@ reduceJS program =
338 map reduce candidates ++ map (reduceCall (map funNames candidates)) rest
338 map reduce candidates ++ map (reduceCall (map funNames candidates)) rest
339 where findConstructors :: JS -> Bool
339 where findConstructors :: JS -> Bool
340 findConstructors js
340 findConstructors js
341− | (JSAlloc fun (Just (JSFunction [] (JSSeq body)))) <- js =
341+ | (JSAlloc fun (Just (JSFunction _ (JSSeq body)))) <- js =
342 reducable $ last body
342 reducable $ last body
343 | otherwise = False
343 | otherwise = False
344 where reducable :: JS -> Bool
344 where reducable :: JS -> Bool
@@ -347,24 +347,26 @@ reduceJS program =
347 reducable (JSArray fields) = and $ map reducable fields
347 reducable (JSArray fields) = and $ map reducable fields
348 reducable (JSNum _) = True
348 reducable (JSNum _) = True
349 reducable JSNull = True
349 reducable JSNull = True
350+ reducable (JSIdent _) = True
350 reducable _ = False
351 reducable _ = False
351
352
352 reduce :: JS -> JS
353 reduce :: JS -> JS
353− reduce (JSAlloc fun (Just (JSFunction [] (JSSeq body))))
354+ reduce (JSAlloc fun (Just (JSFunction _ (JSSeq body))))
354 | JSReturn js <- last body = (JSAlloc fun (Just js))
355 | JSReturn js <- last body = (JSAlloc fun (Just js))
355
356
357+ reduce js = js
358+
356 funNames :: JS -> String
359 funNames :: JS -> String
357 funNames (JSAlloc fun _) = fun
360 funNames (JSAlloc fun _) = fun
358
361
359 reduceCall :: [String] -> JS -> JS
362 reduceCall :: [String] -> JS -> JS
360 reduceCall funs (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
363 reduceCall funs (JSApp (JSIdent "__IDRRT__tailcall") [JSFunction [] (
361− JSReturn (JSApp (JSIdent ret) [])
364+ JSReturn (JSApp id@(JSIdent ret) _)
362 )])
365 )])
363− | ret `elem` funs = JSIdent ret
366+ | ret `elem` funs = id
364
367
365− reduceCall funs js@(JSApp (JSIdent fun) [])
368+ reduceCall funs js@(JSApp id@(JSIdent fun) _)
366− | fun `elem` funs = JSIdent fun
369+ | fun `elem` funs = id
367− | otherwise = js
368
370
369 reduceCall funs (JSAlloc fun (Just body)) =
371 reduceCall funs (JSAlloc fun (Just body)) =
370 JSAlloc fun (Just $ reduceCall funs body)
372 JSAlloc fun (Just $ reduceCall funs body)
@@ -886,8 +888,8 @@ translateExpression patterncase
886 (checkCon `jsAnd` checkTag, branch)
888 (checkCon `jsAnd` checkTag, branch)
887
889
888 | TypeCase ty <- caseTy =
890 | TypeCase ty <- caseTy =
889− let checkTy = JSRaw var `jsInstanceOf` jsType
891+ let checkTy = JSIdent var `jsInstanceOf` jsType
890− checkTag = jsTypeTag (JSRaw var) `jsEq` JSType ty in
892+ checkTag = jsTypeTag (JSIdent var) `jsEq` JSType ty in
891 (checkTy `jsAnd` checkTag, branch)
893 (checkTy `jsAnd` checkTag, branch)
892
894
893translateExpression (SCon i name vars) =
895translateExpression (SCon i name vars) =
@@ -899,7 +901,7 @@ translateExpression (SUpdate var e) =
899 JSAssign (JSVar var) (translateExpression e)
901 JSAssign (JSVar var) (translateExpression e)
900
902
901translateExpression (SProj var i) =
903translateExpression (SProj var i) =
902− JSIndex (JSProj (JSVar var) "vars") (JSRaw $ show i)
904+ JSIndex (JSProj (JSVar var) "vars") (JSNum $ JSInt i)
903
905
904translateExpression SNothing = JSNull
906translateExpression SNothing = JSNull
905
907
@@ -962,11 +964,11 @@ translateCaseCond var cse@(SConstCase ty _)
962 matchHelper ty = (CaseCond $ TypeCase ty, translateCase Nothing cse)
964 matchHelper ty = (CaseCond $ TypeCase ty, translateCase Nothing cse)
963
965
964translateCaseCond var cse@(SConstCase cst@(BI _) _) =
966translateCaseCond var cse@(SConstCase cst@(BI _) _) =
965− let cond = jsMeth (JSRaw var) "equals" [translateConstant cst] in
967+ let cond = jsMeth (JSIdent var) "equals" [translateConstant cst] in
966 (RawCond cond, translateCase Nothing cse)
968 (RawCond cond, translateCase Nothing cse)
967
969
968translateCaseCond var cse@(SConstCase cst _) =
970translateCaseCond var cse@(SConstCase cst _) =
969− let cond = JSRaw var `jsEq` translateConstant cst in
971+ let cond = JSIdent var `jsEq` translateConstant cst in
970 (RawCond cond, translateCase Nothing cse)
972 (RawCond cond, translateCase Nothing cse)
971
973
972translateCaseCond var cse@(SConCase _ tag _ _ _) =
974translateCaseCond var cse@(SConCase _ tag _ _ _) =
@@ -978,5 +980,5 @@ translateCase _ (SConstCase _ e) = translateExpression e
978translateCase (Just var) (SConCase a _ _ vars e) =
980translateCase (Just var) (SConCase a _ _ vars e) =
979 let params = map jsVar [a .. (a + length vars)] in
981 let params = map jsVar [a .. (a + length vars)] in
980 jsMeth (JSFunction params (JSReturn $ translateExpression e)) "apply" [
982 jsMeth (JSFunction params (JSReturn $ translateExpression e)) "apply" [
981− JSThis, JSProj (JSRaw var) "vars"
983+ JSThis, JSProj (JSIdent var) "vars"
982 ]
984 ]