git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1020 from purescript/968
d1300e3Phil Freeman
src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs+30−5
compare with golang
unifiedsplit
@@ -15,6 +15,8 @@
15
15
16module Language.PureScript.CodeGen.JS.Optimizer.TCO (tco) where
16module Language.PureScript.CodeGen.JS.Optimizer.TCO (tco) where
17
17
18+import Data.Monoid
19+
18import Language.PureScript.Options
20import Language.PureScript.Options
19import Language.PureScript.CodeGen.JS.AST
21import Language.PureScript.CodeGen.JS.AST
20
22
@@ -30,10 +32,13 @@ tco' = everywhereOnJS convert
30 where
32 where
31 tcoLabel :: String
33 tcoLabel :: String
32 tcoLabel = "tco"
34 tcoLabel = "tco"
35+
33 tcoVar :: String -> String
36 tcoVar :: String -> String
34 tcoVar arg = "__tco_" ++ arg
37 tcoVar arg = "__tco_" ++ arg
38+
35 copyVar :: String -> String
39 copyVar :: String -> String
36 copyVar arg = "__copy_" ++ arg
40 copyVar arg = "__copy_" ++ arg
41+
37 convert :: JS -> JS
42 convert :: JS -> JS
38 convert js@(JSVariableIntroduction name (Just fn@JSFunction {})) =
43 convert js@(JSVariableIntroduction name (Just fn@JSFunction {})) =
39 let
44 let
@@ -46,6 +51,7 @@ tco' = everywhereOnJS convert
46 JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))
51 JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))
47 | otherwise -> js
52 | otherwise -> js
48 convert js = js
53 convert js = js
54+
49 collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)
55 collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)
50 collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =
56 collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =
51 collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body
57 collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body
@@ -56,25 +62,35 @@ tco' = everywhereOnJS convert
56 collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =
62 collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =
57 (args : allArgs, body, f . JSReturn . JSFunction ident (map copyVar args))
63 (args : allArgs, body, f . JSReturn . JSFunction ident (map copyVar args))
58 collectAllFunctionArgs allArgs f body = (allArgs, body, f)
64 collectAllFunctionArgs allArgs f body = (allArgs, body, f)
65+
59 isTailCall :: String -> JS -> Bool
66 isTailCall :: String -> JS -> Bool
60 isTailCall ident js =
67 isTailCall ident js =
61 let
68 let
62 numSelfCalls = everythingOnJS (+) countSelfCalls js
69 numSelfCalls = everythingOnJS (+) countSelfCalls js
63 numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js
70 numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js
64 numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js
71 numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js
72+ numSelfCallWithFnArgs = everythingOnJS (+) countSelfCallsWithFnArgs js
65 in
73 in
66 numSelfCalls > 0
74 numSelfCalls > 0
67 && numSelfCalls == numSelfCallsInTailPosition
75 && numSelfCalls == numSelfCallsInTailPosition
68 && numSelfCallsUnderFunctions == 0
76 && numSelfCallsUnderFunctions == 0
77+ && numSelfCallWithFnArgs == 0
69 where
78 where
70 countSelfCalls :: JS -> Int
79 countSelfCalls :: JS -> Int
71 countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1
80 countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1
72 countSelfCalls _ = 0
81 countSelfCalls _ = 0
82+
73 countSelfCallsInTailPosition :: JS -> Int
83 countSelfCallsInTailPosition :: JS -> Int
74 countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1
84 countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1
75 countSelfCallsInTailPosition _ = 0
85 countSelfCallsInTailPosition _ = 0
86+
87+ countSelfCallsUnderFunctions :: JS -> Int
76 countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'
88 countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'
77 countSelfCallsUnderFunctions _ = 0
89 countSelfCallsUnderFunctions _ = 0
90+
91+ countSelfCallsWithFnArgs :: JS -> Int
92+ countSelfCallsWithFnArgs ret = if isSelfCallWithFnArgs ident ret [] then 1 else 0
93+
78 toLoop :: String -> [String] -> JS -> JS
94 toLoop :: String -> [String] -> JS -> JS
79 toLoop ident allArgs js = JSBlock $
95 toLoop ident allArgs js = JSBlock $
80 map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++
96 map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++
@@ -94,10 +110,19 @@ tco' = everywhereOnJS convert
94 collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]
110 collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]
95 collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn
111 collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn
96 collectSelfCallArgs allArgumentValues _ = allArgumentValues
112 collectSelfCallArgs allArgumentValues _ = allArgumentValues
113+
97 isSelfCall :: String -> JS -> Bool
114 isSelfCall :: String -> JS -> Bool
98− isSelfCall ident (JSApp (JSVar ident') args) | ident == ident' && not (any isFunction args) = True
115+ isSelfCall ident (JSApp (JSVar ident') _) = ident == ident'
99− isSelfCall ident (JSApp fn args) | not (any isFunction args) = isSelfCall ident fn
116+ isSelfCall ident (JSApp fn _) = isSelfCall ident fn
100 isSelfCall _ _ = False
117 isSelfCall _ _ = False
101− isFunction :: JS -> Bool
118+
119+ isSelfCallWithFnArgs :: String -> JS -> [JS] -> Bool
120+ isSelfCallWithFnArgs ident (JSVar ident') args | ident == ident' && any hasFunction args = True
121+ isSelfCallWithFnArgs ident (JSApp fn args) acc = isSelfCallWithFnArgs ident fn (args ++ acc)
122+ isSelfCallWithFnArgs _ _ _ = False
123+
124+ hasFunction :: JS -> Bool
125+ hasFunction = getAny . everythingOnJS mappend (Any . isFunction)
126+ where
102− isFunction (JSFunction _ _ _) = True
127+ isFunction (JSFunction _ _ _) = True
103− isFunction _ = False
128+ isFunction _ = False