-- | This module implements tail call elimination.
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 qualified Data.Set as S
import Data.Text (Text, pack)
import Language.PureScript.CoreImp.AST
import Language.PureScript.AST.SourcePos (SourceSpan)
import Safe (headDef, tailSafe)

-- | Eliminate tail calls
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
      -- ^ this is the number of calls, not the number of arguments, if there's
      -- ever a practical difference.
      ([[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

  -- If `ident` is a tail-recursive function, returns a set of identifiers
  -- that are locally bound to functions participating in the tail recursion.
  -- Otherwise, returns Nothing.
  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

  -- Returns set of identifiers (with their arities) that need to be used
  -- exclusively in tail calls using their full arity in order for this
  -- identifier to be considered in tail position (or Nothing if this
  -- identifier is used somewhere not as a tail call with full arity).
  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)