Skip to content

Trigger TCO even when there are some self references in non-tail positions #3968

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
radrow wants to merge 1 commit into
base: master
Choose a base branch
from
Draft

Trigger TCO even when there are some self references in non-tail positions #3968

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CONTRIBUTORS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -97,6 +97,7 @@ If you would prefer to use different terms, please use the section below instead
| [@philopon](https://github.com/philopon) | Hirotomo Moriwaki | [MIT license](http://opensource.org/licenses/MIT) |
| [@pseudonom](https://github.com/pseudonom) | Eric Easley | [MIT license](http://opensource.org/licenses/MIT) |
| [@quesebifurcan](https://github.com/quesebifurcan) | Fredrik Wallberg | [MIT license](http://opensource.org/licenses/MIT) |
| [@radrow](https://github.com/radrow) | Radosław Rowicki | [MIT license](http://opensource.org/licenses/MIT) |
| [@rhendric](https://github.com/rhendric) | Ryan Hendrickson | [MIT license](http://opensource.org/licenses/MIT) |
| [@rightfold](https://github.com/rightfold) | rightfold | [MIT license](https://opensource.org/licenses/MIT) |
| [@rndnoise](https://www.github.com/rndnoise) | rndnoise | [MIT license](http://opensource.org/licenses/MIT) |
Expand Down
41 changes: 10 additions & 31 deletions src/Language/PureScript/CoreImp/Optimizer/TCO.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -49,37 +49,16 @@ tco = everywhere convert where
collectAllFunctionArgs allArgs f body = (allArgs, body, f)

isTailRecursive :: Text -> AST -> Bool
isTailRecursive ident js = countSelfReferences js > 0 && allInTailPosition js where
countSelfReferences = everything (+) match where
match :: AST -> Int
match (Var _ ident') | ident == ident' = 1
match _ = 0

allInTailPosition (Return _ expr)
| isSelfCall ident expr = countSelfReferences expr == 1
| otherwise = countSelfReferences expr == 0
allInTailPosition (While _ js1 body)
= countSelfReferences js1 == 0 && allInTailPosition body
allInTailPosition (For _ _ js1 js2 body)
= countSelfReferences js1 == 0 && countSelfReferences js2 == 0 && allInTailPosition body
allInTailPosition (ForIn _ _ js1 body)
= countSelfReferences js1 == 0 && allInTailPosition body
allInTailPosition (IfElse _ js1 body el)
= countSelfReferences js1 == 0 && allInTailPosition body && all allInTailPosition el
allInTailPosition (Block _ body)
= all allInTailPosition body
allInTailPosition (Throw _ js1)
= countSelfReferences js1 == 0
allInTailPosition (ReturnNoResult _)
= True
allInTailPosition (VariableIntroduction _ _ js1)
= all ((== 0) . countSelfReferences) js1
allInTailPosition (Assignment _ _ js1)
= countSelfReferences js1 == 0
allInTailPosition (Comment _ _ js1)
= allInTailPosition js1
allInTailPosition _
= False
isTailRecursive ident js = anyInTailPosition js where

anyInTailPosition :: AST -> Bool
anyInTailPosition (Return _ expr) = isSelfCall ident expr
anyInTailPosition (While _ _ body) = anyInTailPosition body
anyInTailPosition (For _ _ _ _ body) = anyInTailPosition body
anyInTailPosition (ForIn _ _ _ body) = anyInTailPosition body
anyInTailPosition (IfElse _ _ body el) = anyInTailPosition body || any anyInTailPosition el
anyInTailPosition (Block _ body) = any anyInTailPosition body
anyInTailPosition _ = False

toLoop :: Text -> [Text] -> [Text] -> AST -> AST
toLoop ident outerArgs innerArgs js =
Expand Down
49 changes: 49 additions & 0 deletions tests/purs/passing/OccasionalTCO.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,49 @@
module Main where

import Prelude
import Effect.Console (log)

main = do
let _ = occasionalTCO1 10000000
let _ = occasionalTCO2 10000000
let _ = occasionalTCO3 10000000
let _ = occasionalTCO4 10000000
let _ = occasionalTCO5 10000000
log "Done"

occasionalTCO1 :: Int -> Int
occasionalTCO1 0 = 1
occasionalTCO1 n =
occasionalTCO1 (n - occasionalTCO1 0)

occasionalTCO2 :: Int -> Int
occasionalTCO2 0 = 1
occasionalTCO2 n =
let x = occasionalTCO2 0
in occasionalTCO2 (n - x)

occasionalTCO3 :: Int -> Int
occasionalTCO3 0 = 1
occasionalTCO3 n =
if occasionalTCO3 0 == n
then 1
else occasionalTCO3 (n - occasionalTCO3 0)

occasionalTCO4 :: Int -> Int
occasionalTCO4 0 = 1
occasionalTCO4 n | 1 <- occasionalTCO4 0 =
case occasionalTCO4 0 + n of
2 -> 1
x -> occasionalTCO4 (x - 2)
occasionalTCO4 _ = 1

occasionalTCO5 :: Int -> Int
occasionalTCO5 0 = 1
occasionalTCO5 n | n > 10 =
occasionalTCO5 (n - 1)
occasionalTCO5 n =
if n > 5
then occasionalTCO5 $ n - 1
else call occasionalTCO5 (n - 1)

call f x = f x