module Language.PureScript.CoreImp.Optimizer.TCO (tco) where
import Prelude
import Control.Applicative (empty, liftA2)
import Control.Monad (guard)
import Control.Monad.State (State, evalState, get, modify)
import Data.Functor (($>), (<&>))
import Data.Set qualified as S
import Data.Text (Text, pack)
import Language.PureScript.CoreImp.AST (AST(..), InitializerEffects(..), UnaryOperator(..), everything, everywhereTopDownM)
import Language.PureScript.AST.SourcePos (SourceSpan)
import Safe (headDef, tailSafe)
tco :: AST -> AST
tco :: AST -> AST
tco = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => (AST -> m AST) -> AST -> m AST
everywhereTopDownM AST -> State Int AST
convert where
tcoVar :: Text -> Text
tcoVar :: Text -> Text
tcoVar Text
arg = Text
"$tco_var_" forall a. Semigroup a => a -> a -> a
<> Text
arg
copyVar :: Text -> Text
copyVar :: Text -> Text
copyVar Text
arg = Text
"$copy_" forall a. Semigroup a => a -> a -> a
<> Text
arg
tcoDoneM :: State Int Text
tcoDoneM :: State Int Text
tcoDoneM = forall s (m :: * -> *). MonadState s m => m s
get forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
count -> Text
"$tco_done" forall a. Semigroup a => a -> a -> a
<>
if Int
count forall a. Eq a => a -> a -> Bool
== Int
0 then Text
"" else String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
count
tcoLoop :: Text
tcoLoop :: Text
tcoLoop = Text
"$tco_loop"
tcoResult :: Text
tcoResult :: Text
tcoResult = Text
"$tco_result"
convert :: AST -> State Int AST
convert :: AST -> State Int AST
convert (VariableIntroduction Maybe SourceSpan
ss Text
name (Just (InitializerEffects
p, fn :: AST
fn@Function {})))
| Just Set Text
trFns <- Text -> Int -> AST -> Maybe (Set Text)
findTailRecursiveFns Text
name Int
arity AST
body'
= Maybe SourceSpan -> Text -> Maybe (InitializerEffects, AST) -> AST
VariableIntroduction Maybe SourceSpan
ss Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InitializerEffects
p,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST -> AST
replace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Text -> Text -> Int -> [Text] -> [Text] -> AST -> State Int AST
toLoop Set Text
trFns Text
name Int
arity [Text]
outerArgs [Text]
innerArgs AST
body'
where
innerArgs :: [Text]
innerArgs = forall a. a -> [a] -> a
headDef [] [[Text]]
argss
outerArgs :: [Text]
outerArgs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tailSafe [[Text]]
argss
arity :: Int
arity = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Text]]
argss
([[Text]]
argss, AST
body', AST -> AST
replace) = [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
topCollectAllFunctionArgs [] forall a. a -> a
id AST
fn
convert AST
js = forall (f :: * -> *) a. Applicative f => a -> f a
pure AST
js
rewriteFunctionsWith :: ([Text] -> [Text]) -> [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
rewriteFunctionsWith :: ([Text] -> [Text])
-> [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
rewriteFunctionsWith [Text] -> [Text]
argMapper = [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
collectAllFunctionArgs
where
collectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
collectAllFunctionArgs [[Text]]
allArgs AST -> AST
f (Function Maybe SourceSpan
s1 Maybe Text
ident [Text]
args (Block Maybe SourceSpan
s2 (body :: AST
body@(Return Maybe SourceSpan
_ AST
_):[AST]
_))) =
[[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
collectAllFunctionArgs ([Text]
args forall a. a -> [a] -> [a]
: [[Text]]
allArgs) (\AST
b -> AST -> AST
f (Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function Maybe SourceSpan
s1 Maybe Text
ident ([Text] -> [Text]
argMapper [Text]
args) (Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
s2 [AST
b]))) AST
body
collectAllFunctionArgs [[Text]]
allArgs AST -> AST
f (Function Maybe SourceSpan
ss Maybe Text
ident [Text]
args body :: AST
body@(Block Maybe SourceSpan
_ [AST]
_)) =
([Text]
args forall a. a -> [a] -> [a]
: [[Text]]
allArgs, AST
body, AST -> AST
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function Maybe SourceSpan
ss Maybe Text
ident ([Text] -> [Text]
argMapper [Text]
args))
collectAllFunctionArgs [[Text]]
allArgs AST -> AST
f (Return Maybe SourceSpan
s1 (Function Maybe SourceSpan
s2 Maybe Text
ident [Text]
args (Block Maybe SourceSpan
s3 [AST
body]))) =
[[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
collectAllFunctionArgs ([Text]
args forall a. a -> [a] -> [a]
: [[Text]]
allArgs) (\AST
b -> AST -> AST
f (Maybe SourceSpan -> AST -> AST
Return Maybe SourceSpan
s1 (Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function Maybe SourceSpan
s2 Maybe Text
ident ([Text] -> [Text]
argMapper [Text]
args) (Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
s3 [AST
b])))) AST
body
collectAllFunctionArgs [[Text]]
allArgs AST -> AST
f (Return Maybe SourceSpan
s1 (Function Maybe SourceSpan
s2 Maybe Text
ident [Text]
args body :: AST
body@(Block Maybe SourceSpan
_ [AST]
_))) =
([Text]
args forall a. a -> [a] -> [a]
: [[Text]]
allArgs, AST
body, AST -> AST
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SourceSpan -> AST -> AST
Return Maybe SourceSpan
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function Maybe SourceSpan
s2 Maybe Text
ident ([Text] -> [Text]
argMapper [Text]
args))
collectAllFunctionArgs [[Text]]
allArgs AST -> AST
f AST
body = ([[Text]]
allArgs, AST
body, AST -> AST
f)
topCollectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
topCollectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
topCollectAllFunctionArgs = ([Text] -> [Text])
-> [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
rewriteFunctionsWith (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
copyVar)
innerCollectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
innerCollectAllFunctionArgs :: [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
innerCollectAllFunctionArgs = ([Text] -> [Text])
-> [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
rewriteFunctionsWith forall a. a -> a
id
countReferences :: Text -> AST -> Int
countReferences :: Text -> AST -> Int
countReferences Text
ident = forall r. (r -> r -> r) -> (AST -> r) -> AST -> r
everything forall a. Num a => a -> a -> a
(+) AST -> Int
match where
match :: AST -> Int
match :: AST -> Int
match (Var Maybe SourceSpan
_ Text
ident') | Text
ident forall a. Eq a => a -> a -> Bool
== Text
ident' = Int
1
match AST
_ = Int
0
findTailRecursiveFns :: Text -> Int -> AST -> Maybe (S.Set Text)
findTailRecursiveFns :: Text -> Int -> AST -> Maybe (Set Text)
findTailRecursiveFns Text
ident Int
arity AST
js = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> AST -> Int
countReferences Text
ident AST
js forall a. Ord a => a -> a -> Bool
> Int
0) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Set Text, Set (Text, Int)) -> Maybe (Set Text)
go (forall a. Set a
S.empty, forall a. a -> Set a
S.singleton (Text
ident, Int
arity))
where
go :: (S.Set Text, S.Set (Text, Int)) -> Maybe (S.Set Text)
go :: (Set Text, Set (Text, Int)) -> Maybe (Set Text)
go (Set Text
known, Set (Text, Int)
required) =
case forall a. Set a -> Maybe (a, Set a)
S.minView Set (Text, Int)
required of
Just ((Text, Int)
r, Set (Text, Int)
required') -> do
Set (Text, Int)
required'' <- (Text, Int) -> AST -> Maybe (Set (Text, Int))
findTailPositionDeps (Text, Int)
r AST
js
(Set Text, Set (Text, Int)) -> Maybe (Set Text)
go (forall a. Ord a => a -> Set a -> Set a
S.insert (forall a b. (a, b) -> a
fst (Text, Int)
r) Set Text
known, Set (Text, Int)
required' forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Bool) -> Set a -> Set a
S.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
known) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Set (Text, Int)
required'')
Maybe ((Text, Int), Set (Text, Int))
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Text
known
findTailPositionDeps :: (Text, Int) -> AST -> Maybe (S.Set (Text, Int))
findTailPositionDeps :: (Text, Int) -> AST -> Maybe (Set (Text, Int))
findTailPositionDeps (Text
ident, Int
arity) = AST -> Maybe (Set (Text, Int))
allInTailPosition where
countSelfReferences :: AST -> Int
countSelfReferences = Text -> AST -> Int
countReferences Text
ident
allInTailPosition :: AST -> Maybe (Set (Text, Int))
allInTailPosition (Return Maybe SourceSpan
_ AST
expr)
| Text -> Int -> AST -> Bool
isSelfCall Text
ident Int
arity AST
expr = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (AST -> Int
countSelfReferences AST
expr forall a. Eq a => a -> a -> Bool
== Int
1) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Set a
S.empty
| Bool
otherwise = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (AST -> Int
countSelfReferences AST
expr forall a. Eq a => a -> a -> Bool
== Int
0) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Set a
S.empty
allInTailPosition (While Maybe SourceSpan
_ AST
js1 AST
body)
= forall (f :: * -> *). Alternative f => Bool -> f ()
guard (AST -> Int
countSelfReferences AST
js1 forall a. Eq a => a -> a -> Bool
== Int
0) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AST -> Maybe (Set (Text, Int))
allInTailPosition AST
body
allInTailPosition (For Maybe SourceSpan
_ Text
_ AST
js1 AST
js2 AST
body)
= forall (f :: * -> *). Alternative f => Bool -> f ()
guard (AST -> Int
countSelfReferences AST
js1 forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& AST -> Int
countSelfReferences AST
js2 forall a. Eq a => a -> a -> Bool
== Int
0) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AST -> Maybe (Set (Text, Int))
allInTailPosition AST
body
allInTailPosition (ForIn Maybe SourceSpan
_ Text
_ AST
js1 AST
body)
= forall (f :: * -> *). Alternative f => Bool -> f ()
guard (AST -> Int
countSelfReferences AST
js1 forall a. Eq a => a -> a -> Bool
== Int
0) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AST -> Maybe (Set (Text, Int))
allInTailPosition AST
body
allInTailPosition (IfElse Maybe SourceSpan
_ AST
js1 AST
body Maybe AST
el)
= forall (f :: * -> *). Alternative f => Bool -> f ()
guard (AST -> Int
countSelfReferences AST
js1 forall a. Eq a => a -> a -> Bool
== Int
0) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend (AST -> Maybe (Set (Text, Int))
allInTailPosition AST
body) (forall (f :: * -> *) w (t :: * -> *) a.
(Applicative f, Monoid w, Foldable t) =>
(a -> f w) -> t a -> f w
foldMapA AST -> Maybe (Set (Text, Int))
allInTailPosition Maybe AST
el)
allInTailPosition (Block Maybe SourceSpan
_ [AST]
body)
= forall (f :: * -> *) w (t :: * -> *) a.
(Applicative f, Monoid w, Foldable t) =>
(a -> f w) -> t a -> f w
foldMapA AST -> Maybe (Set (Text, Int))
allInTailPosition [AST]
body
allInTailPosition (Throw Maybe SourceSpan
_ AST
js1)
= forall (f :: * -> *). Alternative f => Bool -> f ()
guard (AST -> Int
countSelfReferences AST
js1 forall a. Eq a => a -> a -> Bool
== Int
0) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Set a
S.empty
allInTailPosition (ReturnNoResult Maybe SourceSpan
_)
= forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
S.empty
allInTailPosition (VariableIntroduction Maybe SourceSpan
_ Text
_ Maybe (InitializerEffects, AST)
Nothing)
= forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
S.empty
allInTailPosition (VariableIntroduction Maybe SourceSpan
_ Text
ident' (Just (InitializerEffects
_, AST
js1)))
| AST -> Int
countSelfReferences AST
js1 forall a. Eq a => a -> a -> Bool
== Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Set a
S.empty
| Function Maybe SourceSpan
_ Maybe Text
Nothing [Text]
_ AST
_ <- AST
js1
, ([[Text]]
argss, AST
body, AST -> AST
_) <- [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
innerCollectAllFunctionArgs [] forall a. a -> a
id AST
js1
= forall a. Ord a => a -> Set a -> Set a
S.insert (Text
ident', forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Text]]
argss) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AST -> Maybe (Set (Text, Int))
allInTailPosition AST
body
| Bool
otherwise = forall (f :: * -> *) a. Alternative f => f a
empty
allInTailPosition (Assignment Maybe SourceSpan
_ AST
_ AST
js1)
= forall (f :: * -> *). Alternative f => Bool -> f ()
guard (AST -> Int
countSelfReferences AST
js1 forall a. Eq a => a -> a -> Bool
== Int
0) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Set a
S.empty
allInTailPosition (Comment CIComments
_ AST
js1)
= AST -> Maybe (Set (Text, Int))
allInTailPosition AST
js1
allInTailPosition AST
_
= forall (f :: * -> *) a. Alternative f => f a
empty
toLoop :: S.Set Text -> Text -> Int -> [Text] -> [Text] -> AST -> State Int AST
toLoop :: Set Text -> Text -> Int -> [Text] -> [Text] -> AST -> State Int AST
toLoop Set Text
trFns Text
ident Int
arity [Text]
outerArgs [Text]
innerArgs AST
js = do
Text
tcoDone <- State Int Text
tcoDoneM
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Num a => a -> a -> a
+ Int
1)
let
markDone :: Maybe SourceSpan -> AST
markDone :: Maybe SourceSpan -> AST
markDone Maybe SourceSpan
ss = Maybe SourceSpan -> AST -> AST -> AST
Assignment Maybe SourceSpan
ss (Maybe SourceSpan -> Text -> AST
Var Maybe SourceSpan
ss Text
tcoDone) (Maybe SourceSpan -> Bool -> AST
BooleanLiteral Maybe SourceSpan
ss Bool
True)
loopify :: AST -> AST
loopify :: AST -> AST
loopify (Return Maybe SourceSpan
ss AST
ret)
| Text -> Int -> AST -> Bool
isSelfCall Text
ident Int
arity AST
ret =
let
allArgumentValues :: [AST]
allArgumentValues = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [[AST]] -> AST -> [[AST]]
collectArgs [] AST
ret
in
Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\AST
val Text
arg ->
Maybe SourceSpan -> AST -> AST -> AST
Assignment Maybe SourceSpan
ss (Maybe SourceSpan -> Text -> AST
Var Maybe SourceSpan
ss (Text -> Text
tcoVar Text
arg)) AST
val) [AST]
allArgumentValues [Text]
outerArgs
forall a. [a] -> [a] -> [a]
++ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\AST
val Text
arg ->
Maybe SourceSpan -> AST -> AST -> AST
Assignment Maybe SourceSpan
ss (Maybe SourceSpan -> Text -> AST
Var Maybe SourceSpan
ss (Text -> Text
copyVar Text
arg)) AST
val) (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
outerArgs) [AST]
allArgumentValues) [Text]
innerArgs
forall a. [a] -> [a] -> [a]
++ [ Maybe SourceSpan -> AST
ReturnNoResult Maybe SourceSpan
ss ]
| AST -> Bool
isIndirectSelfCall AST
ret = Maybe SourceSpan -> AST -> AST
Return Maybe SourceSpan
ss AST
ret
| Bool
otherwise = Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss [ Maybe SourceSpan -> AST
markDone Maybe SourceSpan
ss, Maybe SourceSpan -> AST -> AST
Return Maybe SourceSpan
ss AST
ret ]
loopify (ReturnNoResult Maybe SourceSpan
ss) = Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss [ Maybe SourceSpan -> AST
markDone Maybe SourceSpan
ss, Maybe SourceSpan -> AST
ReturnNoResult Maybe SourceSpan
ss ]
loopify (While Maybe SourceSpan
ss AST
cond AST
body) = Maybe SourceSpan -> AST -> AST -> AST
While Maybe SourceSpan
ss AST
cond (AST -> AST
loopify AST
body)
loopify (For Maybe SourceSpan
ss Text
i AST
js1 AST
js2 AST
body) = Maybe SourceSpan -> Text -> AST -> AST -> AST -> AST
For Maybe SourceSpan
ss Text
i AST
js1 AST
js2 (AST -> AST
loopify AST
body)
loopify (ForIn Maybe SourceSpan
ss Text
i AST
js1 AST
body) = Maybe SourceSpan -> Text -> AST -> AST -> AST
ForIn Maybe SourceSpan
ss Text
i AST
js1 (AST -> AST
loopify AST
body)
loopify (IfElse Maybe SourceSpan
ss AST
cond AST
body Maybe AST
el) = Maybe SourceSpan -> AST -> AST -> Maybe AST -> AST
IfElse Maybe SourceSpan
ss AST
cond (AST -> AST
loopify AST
body) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AST -> AST
loopify Maybe AST
el)
loopify (Block Maybe SourceSpan
ss [AST]
body) = Maybe SourceSpan -> [AST] -> AST
Block Maybe SourceSpan
ss (forall a b. (a -> b) -> [a] -> [b]
map AST -> AST
loopify [AST]
body)
loopify (VariableIntroduction Maybe SourceSpan
ss Text
f (Just (InitializerEffects
p, fn :: AST
fn@(Function Maybe SourceSpan
_ Maybe Text
Nothing [Text]
_ AST
_))))
| ([[Text]]
_, AST
body, AST -> AST
replace) <- [[Text]] -> (AST -> AST) -> AST -> ([[Text]], AST, AST -> AST)
innerCollectAllFunctionArgs [] forall a. a -> a
id AST
fn
, Text
f forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
trFns = Maybe SourceSpan -> Text -> Maybe (InitializerEffects, AST) -> AST
VariableIntroduction Maybe SourceSpan
ss Text
f (forall a. a -> Maybe a
Just (InitializerEffects
p, AST -> AST
replace (AST -> AST
loopify AST
body)))
loopify AST
other = AST
other
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe SourceSpan -> [AST] -> AST
Block forall {a}. Maybe a
rootSS forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\Text
arg -> Maybe SourceSpan -> Text -> Maybe (InitializerEffects, AST) -> AST
VariableIntroduction forall {a}. Maybe a
rootSS (Text -> Text
tcoVar Text
arg) (forall a. a -> Maybe a
Just (InitializerEffects
UnknownEffects, Maybe SourceSpan -> Text -> AST
Var forall {a}. Maybe a
rootSS (Text -> Text
copyVar Text
arg)))) [Text]
outerArgs forall a. [a] -> [a] -> [a]
++
[ Maybe SourceSpan -> Text -> Maybe (InitializerEffects, AST) -> AST
VariableIntroduction forall {a}. Maybe a
rootSS Text
tcoDone (forall a. a -> Maybe a
Just (InitializerEffects
UnknownEffects, Maybe SourceSpan -> Bool -> AST
BooleanLiteral forall {a}. Maybe a
rootSS Bool
False))
, Maybe SourceSpan -> Text -> Maybe (InitializerEffects, AST) -> AST
VariableIntroduction forall {a}. Maybe a
rootSS Text
tcoResult forall {a}. Maybe a
Nothing
, Maybe SourceSpan -> Maybe Text -> [Text] -> AST -> AST
Function forall {a}. Maybe a
rootSS (forall a. a -> Maybe a
Just Text
tcoLoop) ([Text]
outerArgs forall a. [a] -> [a] -> [a]
++ [Text]
innerArgs) (Maybe SourceSpan -> [AST] -> AST
Block forall {a}. Maybe a
rootSS [AST -> AST
loopify AST
js])
, Maybe SourceSpan -> AST -> AST -> AST
While forall {a}. Maybe a
rootSS (Maybe SourceSpan -> UnaryOperator -> AST -> AST
Unary forall {a}. Maybe a
rootSS UnaryOperator
Not (Maybe SourceSpan -> Text -> AST
Var forall {a}. Maybe a
rootSS Text
tcoDone))
(Maybe SourceSpan -> [AST] -> AST
Block forall {a}. Maybe a
rootSS
[Maybe SourceSpan -> AST -> AST -> AST
Assignment forall {a}. Maybe a
rootSS (Maybe SourceSpan -> Text -> AST
Var forall {a}. Maybe a
rootSS Text
tcoResult) (Maybe SourceSpan -> AST -> [AST] -> AST
App forall {a}. Maybe a
rootSS (Maybe SourceSpan -> Text -> AST
Var forall {a}. Maybe a
rootSS Text
tcoLoop) (forall a b. (a -> b) -> [a] -> [b]
map (Maybe SourceSpan -> Text -> AST
Var forall {a}. Maybe a
rootSS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
tcoVar) [Text]
outerArgs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Maybe SourceSpan -> Text -> AST
Var forall {a}. Maybe a
rootSS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
copyVar) [Text]
innerArgs))])
, Maybe SourceSpan -> AST -> AST
Return forall {a}. Maybe a
rootSS (Maybe SourceSpan -> Text -> AST
Var forall {a}. Maybe a
rootSS Text
tcoResult)
]
where
rootSS :: Maybe a
rootSS = forall {a}. Maybe a
Nothing
collectArgs :: [[AST]] -> AST -> [[AST]]
collectArgs :: [[AST]] -> AST -> [[AST]]
collectArgs [[AST]]
acc (App Maybe SourceSpan
_ AST
fn [AST]
args') = [[AST]] -> AST -> [[AST]]
collectArgs ([AST]
args' forall a. a -> [a] -> [a]
: [[AST]]
acc) AST
fn
collectArgs [[AST]]
acc AST
_ = [[AST]]
acc
isIndirectSelfCall :: AST -> Bool
isIndirectSelfCall :: AST -> Bool
isIndirectSelfCall (App Maybe SourceSpan
_ (Var Maybe SourceSpan
_ Text
ident') [AST]
_) = Text
ident' forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
trFns
isIndirectSelfCall (App Maybe SourceSpan
_ AST
fn [AST]
_) = AST -> Bool
isIndirectSelfCall AST
fn
isIndirectSelfCall AST
_ = Bool
False
isSelfCall :: Text -> Int -> AST -> Bool
isSelfCall :: Text -> Int -> AST -> Bool
isSelfCall Text
ident Int
1 (App Maybe SourceSpan
_ (Var Maybe SourceSpan
_ Text
ident') [AST]
_) = Text
ident forall a. Eq a => a -> a -> Bool
== Text
ident'
isSelfCall Text
ident Int
arity (App Maybe SourceSpan
_ AST
fn [AST]
_) = Text -> Int -> AST -> Bool
isSelfCall Text
ident (Int
arity forall a. Num a => a -> a -> a
- Int
1) AST
fn
isSelfCall Text
_ Int
_ AST
_ = Bool
False
foldMapA :: (Applicative f, Monoid w, Foldable t) => (a -> f w) -> t a -> f w
foldMapA :: forall (f :: * -> *) w (t :: * -> *) a.
(Applicative f, Monoid w, Foldable t) =>
(a -> f w) -> t a -> f w
foldMapA a -> f w
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f w
f) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)