    -- | This module exports functionality for generating a call graph of
    -- an Futhark program.
    module Futhark.Analysis.CallGraph
      ( CallGraph,
        buildCallGraph,
        isFunInCallGraph,
        calls,
        calledByConsts,
        allCalledBy,
        numOccurences,
      )
    where

    import Control.Monad.Writer.Strict
    import Data.List (foldl')
    import Data.Map.Strict qualified as M
    import Data.Maybe (isJust)
    import Data.Set qualified as S
    import Futhark.IR.SOACS
    import Futhark.Util.Pretty

    type FunctionTable = M.Map Name (FunDef SOACS)

    buildFunctionTable :: Prog SOACS -> FunctionTable
    buildFunctionTable :: Prog SOACS -> FunctionTable
    buildFunctionTable = (FunctionTable -> FunDef SOACS -> FunctionTable)
    -> FunctionTable -> [FunDef SOACS] -> FunctionTable
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl FunctionTable -> FunDef SOACS -> FunctionTable
    forall {rep}.
    Map Name (FunDef rep) -> FunDef rep -> Map Name (FunDef rep)
    expand FunctionTable
    forall k a. Map k a
    M.empty ([FunDef SOACS] -> FunctionTable)
    -> (Prog SOACS -> [FunDef SOACS]) -> Prog SOACS -> FunctionTable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Prog SOACS -> [FunDef SOACS]
    forall rep. Prog rep -> [FunDef rep]
    progFuns
      where
        expand :: Map Name (FunDef rep) -> FunDef rep -> Map Name (FunDef rep)
    expand Map Name (FunDef rep)
    ftab FunDef rep
    f = Name
    -> FunDef rep -> Map Name (FunDef rep) -> Map Name (FunDef rep)
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert (FunDef rep -> Name
    forall rep. FunDef rep -> Name
    funDefName FunDef rep
    f) FunDef rep
    f Map Name (FunDef rep)
    ftab

    -- | A unique (at least within a function) name identifying a function
    -- call.  In practice the first element of the corresponding pattern.
    type CallId = VName

    data FunCalls = FunCalls
      { FunCalls -> Map CallId (Attrs, Name)
    fcMap :: M.Map CallId (Attrs, Name),
        FunCalls -> Set Name
    fcAllCalled :: S.Set Name
      }
      deriving (FunCalls -> FunCalls -> Bool
    (FunCalls -> FunCalls -> Bool)
    -> (FunCalls -> FunCalls -> Bool) -> Eq FunCalls
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FunCalls -> FunCalls -> Bool
    == :: FunCalls -> FunCalls -> Bool
    $c/= :: FunCalls -> FunCalls -> Bool
    /= :: FunCalls -> FunCalls -> Bool
    Eq, Eq FunCalls
    Eq FunCalls =>
    (FunCalls -> FunCalls -> Ordering)
    -> (FunCalls -> FunCalls -> Bool)
    -> (FunCalls -> FunCalls -> Bool)
    -> (FunCalls -> FunCalls -> Bool)
    -> (FunCalls -> FunCalls -> Bool)
    -> (FunCalls -> FunCalls -> FunCalls)
    -> (FunCalls -> FunCalls -> FunCalls)
    -> Ord FunCalls
    FunCalls -> FunCalls -> Bool
    FunCalls -> FunCalls -> Ordering
    FunCalls -> FunCalls -> FunCalls
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: FunCalls -> FunCalls -> Ordering
    compare :: FunCalls -> FunCalls -> Ordering
    $c< :: FunCalls -> FunCalls -> Bool
    < :: FunCalls -> FunCalls -> Bool
    $c<= :: FunCalls -> FunCalls -> Bool
    <= :: FunCalls -> FunCalls -> Bool
    $c> :: FunCalls -> FunCalls -> Bool
    > :: FunCalls -> FunCalls -> Bool
    $c>= :: FunCalls -> FunCalls -> Bool
    >= :: FunCalls -> FunCalls -> Bool
    $cmax :: FunCalls -> FunCalls -> FunCalls
    max :: FunCalls -> FunCalls -> FunCalls
    $cmin :: FunCalls -> FunCalls -> FunCalls
    min :: FunCalls -> FunCalls -> FunCalls
    Ord, Int -> FunCalls -> ShowS
    [FunCalls] -> ShowS
    FunCalls -> String
    (Int -> FunCalls -> ShowS)
    -> (FunCalls -> String) -> ([FunCalls] -> ShowS) -> Show FunCalls
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FunCalls -> ShowS
    showsPrec :: Int -> FunCalls -> ShowS
    $cshow :: FunCalls -> String
    show :: FunCalls -> String
    $cshowList :: [FunCalls] -> ShowS
    showList :: [FunCalls] -> ShowS
    Show)

    instance Monoid FunCalls where
      mempty :: FunCalls
    mempty = Map CallId (Attrs, Name) -> Set Name -> FunCalls
    FunCalls Map CallId (Attrs, Name)
    forall a. Monoid a => a
    mempty Set Name
    forall a. Monoid a => a
    mempty

    instance Semigroup FunCalls where
      FunCalls Map CallId (Attrs, Name)
    x1 Set Name
    y1 <> :: FunCalls -> FunCalls -> FunCalls
    <> FunCalls Map CallId (Attrs, Name)
    x2 Set Name
    y2 = Map CallId (Attrs, Name) -> Set Name -> FunCalls
    FunCalls (Map CallId (Attrs, Name)
    x1 Map CallId (Attrs, Name)
    -> Map CallId (Attrs, Name) -> Map CallId (Attrs, Name)
    forall a. Semigroup a => a -> a -> a
    <> Map CallId (Attrs, Name)
    x2) (Set Name
    y1 Set Name -> Set Name -> Set Name
    forall a. Semigroup a => a -> a -> a
    <> Set Name
    y2)

    fcCalled :: Name -> FunCalls -> Bool
    fcCalled :: Name -> FunCalls -> Bool
    fcCalled Name
    f FunCalls
    fcs = Name
    f Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` FunCalls -> Set Name
    fcAllCalled FunCalls
    fcs

    type FunGraph = M.Map Name FunCalls

    -- | The call graph is a mapping from a function name, i.e., the
    -- caller, to a record of the names of functions called *directly* (not
    -- transitively!) by the function.
    --
    -- We keep track separately of the functions called by constants.
    data CallGraph = CallGraph
      { CallGraph -> FunGraph
    cgCalledByFuns :: FunGraph,
        CallGraph -> FunCalls
    cgCalledByConsts :: FunCalls
      }
      deriving (CallGraph -> CallGraph -> Bool
    (CallGraph -> CallGraph -> Bool)
    -> (CallGraph -> CallGraph -> Bool) -> Eq CallGraph
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CallGraph -> CallGraph -> Bool
    == :: CallGraph -> CallGraph -> Bool
    $c/= :: CallGraph -> CallGraph -> Bool
    /= :: CallGraph -> CallGraph -> Bool
    Eq, Eq CallGraph
    Eq CallGraph =>
    (CallGraph -> CallGraph -> Ordering)
    -> (CallGraph -> CallGraph -> Bool)
    -> (CallGraph -> CallGraph -> Bool)
    -> (CallGraph -> CallGraph -> Bool)
    -> (CallGraph -> CallGraph -> Bool)
    -> (CallGraph -> CallGraph -> CallGraph)
    -> (CallGraph -> CallGraph -> CallGraph)
    -> Ord CallGraph
    CallGraph -> CallGraph -> Bool
    CallGraph -> CallGraph -> Ordering
    CallGraph -> CallGraph -> CallGraph
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: CallGraph -> CallGraph -> Ordering
    compare :: CallGraph -> CallGraph -> Ordering
    $c< :: CallGraph -> CallGraph -> Bool
    < :: CallGraph -> CallGraph -> Bool
    $c<= :: CallGraph -> CallGraph -> Bool
    <= :: CallGraph -> CallGraph -> Bool
    $c> :: CallGraph -> CallGraph -> Bool
    > :: CallGraph -> CallGraph -> Bool
    $c>= :: CallGraph -> CallGraph -> Bool
    >= :: CallGraph -> CallGraph -> Bool
    $cmax :: CallGraph -> CallGraph -> CallGraph
    max :: CallGraph -> CallGraph -> CallGraph
    $cmin :: CallGraph -> CallGraph -> CallGraph
    min :: CallGraph -> CallGraph -> CallGraph
    Ord, Int -> CallGraph -> ShowS
    [CallGraph] -> ShowS
    CallGraph -> String
    (Int -> CallGraph -> ShowS)
    -> (CallGraph -> String)
    -> ([CallGraph] -> ShowS)
    -> Show CallGraph
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> CallGraph -> ShowS
    showsPrec :: Int -> CallGraph -> ShowS
    $cshow :: CallGraph -> String
    show :: CallGraph -> String
    $cshowList :: [CallGraph] -> ShowS
    showList :: [CallGraph] -> ShowS
    Show)

    -- | Is the given function known to the call graph?
    isFunInCallGraph :: Name -> CallGraph -> Bool
    isFunInCallGraph :: Name -> CallGraph -> Bool
    isFunInCallGraph Name
    f = Name -> FunGraph -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    M.member Name
    f (FunGraph -> Bool) -> (CallGraph -> FunGraph) -> CallGraph -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CallGraph -> FunGraph
    cgCalledByFuns

    -- | Does the first function call the second?
    calls :: Name -> Name -> CallGraph -> Bool
    calls :: Name -> Name -> CallGraph -> Bool
    calls Name
    caller Name
    callee =
      Bool -> (FunCalls -> Bool) -> Maybe FunCalls -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Name -> FunCalls -> Bool
    fcCalled Name
    callee) (Maybe FunCalls -> Bool)
    -> (CallGraph -> Maybe FunCalls) -> CallGraph -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> FunGraph -> Maybe FunCalls
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    caller (FunGraph -> Maybe FunCalls)
    -> (CallGraph -> FunGraph) -> CallGraph -> Maybe FunCalls
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CallGraph -> FunGraph
    cgCalledByFuns

    -- | Is the function called in any of the constants?
    calledByConsts :: Name -> CallGraph -> Bool
    calledByConsts :: Name -> CallGraph -> Bool
    calledByConsts Name
    callee = Name -> FunCalls -> Bool
    fcCalled Name
    callee (FunCalls -> Bool) -> (CallGraph -> FunCalls) -> CallGraph -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CallGraph -> FunCalls
    cgCalledByConsts

    -- | All functions called by this function.
    allCalledBy :: Name -> CallGraph -> S.Set Name
    allCalledBy :: Name -> CallGraph -> Set Name
    allCalledBy Name
    f = Set Name -> (FunCalls -> Set Name) -> Maybe FunCalls -> Set Name
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Set Name
    forall a. Monoid a => a
    mempty FunCalls -> Set Name
    fcAllCalled (Maybe FunCalls -> Set Name)
    -> (CallGraph -> Maybe FunCalls) -> CallGraph -> Set Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> FunGraph -> Maybe FunCalls
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    f (FunGraph -> Maybe FunCalls)
    -> (CallGraph -> FunGraph) -> CallGraph -> Maybe FunCalls
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CallGraph -> FunGraph
    cgCalledByFuns

    -- | @buildCallGraph prog@ build the program's call graph.
    buildCallGraph :: Prog SOACS -> CallGraph
    buildCallGraph :: Prog SOACS -> CallGraph
    buildCallGraph Prog SOACS
    prog =
      FunGraph -> FunCalls -> CallGraph
    CallGraph FunGraph
    fg FunCalls
    cg
      where
        fg :: FunGraph
    fg = (FunGraph -> Name -> FunGraph) -> FunGraph -> Set Name -> FunGraph
    forall b a. (b -> a -> b) -> b -> Set a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (FunctionTable -> FunGraph -> Name -> FunGraph
    buildFGfun FunctionTable
    ftable) FunGraph
    forall k a. Map k a
    M.empty Set Name
    entry_points
        cg :: FunCalls
    cg = Stms SOACS -> FunCalls
    buildFGStms (Stms SOACS -> FunCalls) -> Stms SOACS -> FunCalls
    forall a b. (a -> b) -> a -> b
    $ Prog SOACS -> Stms SOACS
    forall rep. Prog rep -> Stms rep
    progConsts Prog SOACS
    prog

        entry_points :: Set Name
    entry_points =
          [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    S.fromList ((FunDef SOACS -> Name) -> [FunDef SOACS] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FunDef SOACS -> Name
    forall rep. FunDef rep -> Name
    funDefName ((FunDef SOACS -> Bool) -> [FunDef SOACS] -> [FunDef SOACS]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Maybe EntryPoint -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe EntryPoint -> Bool)
    -> (FunDef SOACS -> Maybe EntryPoint) -> FunDef SOACS -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FunDef SOACS -> Maybe EntryPoint
    forall rep. FunDef rep -> Maybe EntryPoint
    funDefEntryPoint) ([FunDef SOACS] -> [FunDef SOACS])
    -> [FunDef SOACS] -> [FunDef SOACS]
    forall a b. (a -> b) -> a -> b
    $ Prog SOACS -> [FunDef SOACS]
    forall rep. Prog rep -> [FunDef rep]
    progFuns Prog SOACS
    prog))
            Set Name -> Set Name -> Set Name
    forall a. Semigroup a => a -> a -> a
    <> FunCalls -> Set Name
    fcAllCalled FunCalls
    cg
        ftable :: FunctionTable
    ftable = Prog SOACS -> FunctionTable
    buildFunctionTable Prog SOACS
    prog

    count :: (Ord k) => [k] -> M.Map k Int
    count :: forall k. Ord k => [k] -> Map k Int
    count [k]
    ks = (Int -> Int -> Int) -> [(k, Int)] -> Map k Int
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    M.fromListWith Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) ([(k, Int)] -> Map k Int) -> [(k, Int)] -> Map k Int
    forall a b. (a -> b) -> a -> b
    $ (k -> (k, Int)) -> [k] -> [(k, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map (,Int
    1) [k]
    ks

    -- | Produce a mapping of the number of occurences in the call graph
    -- of each function.  Only counts functions that are called at least
    -- once.
    numOccurences :: CallGraph -> M.Map Name Int
    numOccurences :: CallGraph -> Map Name Int
    numOccurences (CallGraph FunGraph
    funs FunCalls
    consts) =
      [Name] -> Map Name Int
    forall k. Ord k => [k] -> Map k Int
    count ([Name] -> Map Name Int) -> [Name] -> Map Name Int
    forall a b. (a -> b) -> a -> b
    $ ((Attrs, Name) -> Name) -> [(Attrs, Name)] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Attrs, Name) -> Name
    forall a b. (a, b) -> b
    snd ([(Attrs, Name)] -> [Name]) -> [(Attrs, Name)] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ Map CallId (Attrs, Name) -> [(Attrs, Name)]
    forall k a. Map k a -> [a]
    M.elems (FunCalls -> Map CallId (Attrs, Name)
    fcMap FunCalls
    consts Map CallId (Attrs, Name)
    -> Map CallId (Attrs, Name) -> Map CallId (Attrs, Name)
    forall a. Semigroup a => a -> a -> a
    <> (FunCalls -> Map CallId (Attrs, Name))
    -> [FunCalls] -> Map CallId (Attrs, Name)
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap FunCalls -> Map CallId (Attrs, Name)
    fcMap (FunGraph -> [FunCalls]
    forall k a. Map k a -> [a]
    M.elems FunGraph
    funs))

    -- | @buildCallGraph ftable fg fname@ updates @fg@ with the
    -- contributions of function @fname@.
    buildFGfun :: FunctionTable -> FunGraph -> Name -> FunGraph
    buildFGfun :: FunctionTable -> FunGraph -> Name -> FunGraph
    buildFGfun FunctionTable
    ftable FunGraph
    fg Name
    fname =
      -- Check if function is a non-builtin that we have not already
      -- processed.
      case Name -> FunctionTable -> Maybe (FunDef SOACS)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    fname FunctionTable
    ftable of
        Just FunDef SOACS
    f | Maybe FunCalls
    Nothing <- Name -> FunGraph -> Maybe FunCalls
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    fname FunGraph
    fg -> do
          let callees :: FunCalls
    callees = Body SOACS -> FunCalls
    buildFGBody (Body SOACS -> FunCalls) -> Body SOACS -> FunCalls
    forall a b. (a -> b) -> a -> b
    $ FunDef SOACS -> Body SOACS
    forall rep. FunDef rep -> Body rep
    funDefBody FunDef SOACS
    f
              fg' :: FunGraph
    fg' = Name -> FunCalls -> FunGraph -> FunGraph
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Name
    fname FunCalls
    callees FunGraph
    fg
          -- recursively build the callees
          (FunGraph -> Name -> FunGraph) -> FunGraph -> Set Name -> FunGraph
    forall b a. (b -> a -> b) -> b -> Set a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (FunctionTable -> FunGraph -> Name -> FunGraph
    buildFGfun FunctionTable
    ftable) FunGraph
    fg' (Set Name -> FunGraph) -> Set Name -> FunGraph
    forall a b. (a -> b) -> a -> b
    $ FunCalls -> Set Name
    fcAllCalled FunCalls
    callees
        Maybe (FunDef SOACS)
    _ -> FunGraph
    fg

    buildFGStms :: Stms SOACS -> FunCalls
    buildFGStms :: Stms SOACS -> FunCalls
    buildFGStms = [FunCalls] -> FunCalls
    forall a. Monoid a => [a] -> a
    mconcat ([FunCalls] -> FunCalls)
    -> (Stms SOACS -> [FunCalls]) -> Stms SOACS -> FunCalls
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Stm SOACS -> FunCalls) -> [Stm SOACS] -> [FunCalls]
    forall a b. (a -> b) -> [a] -> [b]
    map Stm SOACS -> FunCalls
    buildFGstm ([Stm SOACS] -> [FunCalls])
    -> (Stms SOACS -> [Stm SOACS]) -> Stms SOACS -> [FunCalls]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Stms SOACS -> [Stm SOACS]
    forall rep. Stms rep -> [Stm rep]
    stmsToList

    buildFGBody :: Body SOACS -> FunCalls
    buildFGBody :: Body SOACS -> FunCalls
    buildFGBody = Stms SOACS -> FunCalls
    buildFGStms (Stms SOACS -> FunCalls)
    -> (Body SOACS -> Stms SOACS) -> Body SOACS -> FunCalls
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Body SOACS -> Stms SOACS
    forall rep. Body rep -> Stms rep
    bodyStms

    buildFGstm :: Stm SOACS -> FunCalls
    buildFGstm :: Stm SOACS -> FunCalls
    buildFGstm (Let (Pat (PatElem (LetDec SOACS)
    p : [PatElem (LetDec SOACS)]
    _)) StmAux (ExpDec SOACS)
    aux (Apply Name
    fname [(SubExp, Diet)]
    _ [(RetType SOACS, RetAls)]
    _ Safety
    _)) =
      Map CallId (Attrs, Name) -> Set Name -> FunCalls
    FunCalls (CallId -> (Attrs, Name) -> Map CallId (Attrs, Name)
    forall k a. k -> a -> Map k a
    M.singleton (PatElem Type -> CallId
    forall dec. PatElem dec -> CallId
    patElemName PatElem Type
    PatElem (LetDec SOACS)
    p) (StmAux () -> Attrs
    forall dec. StmAux dec -> Attrs
    stmAuxAttrs StmAux ()
    StmAux (ExpDec SOACS)
    aux, Name
    fname)) (Name -> Set Name
    forall a. a -> Set a
    S.singleton Name
    fname)
    buildFGstm (Let Pat (LetDec SOACS)
    _ StmAux (ExpDec SOACS)
    _ (Op Op SOACS
    op)) = Writer FunCalls (SOAC SOACS) -> FunCalls
    forall w a. Writer w a -> w
    execWriter (Writer FunCalls (SOAC SOACS) -> FunCalls)
    -> Writer FunCalls (SOAC SOACS) -> FunCalls
    forall a b. (a -> b) -> a -> b
    $ SOACMapper SOACS SOACS (WriterT FunCalls Identity)
    -> SOAC SOACS -> Writer FunCalls (SOAC SOACS)
    forall (m :: * -> *) frep trep.
    Monad m =>
    SOACMapper frep trep m -> SOAC frep -> m (SOAC trep)
    mapSOACM SOACMapper SOACS SOACS (WriterT FunCalls Identity)
    folder Op SOACS
    SOAC SOACS
    op
      where
        folder :: SOACMapper SOACS SOACS (WriterT FunCalls Identity)
    folder =
          SOACMapper Any Any (WriterT FunCalls Identity)
    forall rep (m :: * -> *). Monad m => SOACMapper rep rep m
    identitySOACMapper
            { mapOnSOACLambda = \Lambda SOACS
    lam -> do
                FunCalls -> WriterT FunCalls Identity ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (FunCalls -> WriterT FunCalls Identity ())
    -> FunCalls -> WriterT FunCalls Identity ()
    forall a b. (a -> b) -> a -> b
    $ Body SOACS -> FunCalls
    buildFGBody (Body SOACS -> FunCalls) -> Body SOACS -> FunCalls
    forall a b. (a -> b) -> a -> b
    $ Lambda SOACS -> Body SOACS
    forall rep. Lambda rep -> Body rep
    lambdaBody Lambda SOACS
    lam
                Lambda SOACS -> WriterT FunCalls Identity (Lambda SOACS)
    forall a. a -> WriterT FunCalls Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Lambda SOACS
    lam
            }
    buildFGstm (Let Pat (LetDec SOACS)
    _ StmAux (ExpDec SOACS)
    _ Exp SOACS
    e) = Writer FunCalls (Exp SOACS) -> FunCalls
    forall w a. Writer w a -> w
    execWriter (Writer FunCalls (Exp SOACS) -> FunCalls)
    -> Writer FunCalls (Exp SOACS) -> FunCalls
    forall a b. (a -> b) -> a -> b
    $ Mapper SOACS SOACS (WriterT FunCalls Identity)
    -> Exp SOACS -> Writer FunCalls (Exp SOACS)
    forall (m :: * -> *) frep trep.
    Monad m =>
    Mapper frep trep m -> Exp frep -> m (Exp trep)
    mapExpM Mapper SOACS SOACS (WriterT FunCalls Identity)
    folder Exp SOACS
    e
      where
        folder :: Mapper SOACS SOACS (WriterT FunCalls Identity)
    folder =
          Mapper SOACS SOACS (WriterT FunCalls Identity)
    forall rep (m :: * -> *). Monad m => Mapper rep rep m
    identityMapper
            { mapOnBody = \Scope SOACS
    _ Body SOACS
    body -> do
                FunCalls -> WriterT FunCalls Identity ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (FunCalls -> WriterT FunCalls Identity ())
    -> FunCalls -> WriterT FunCalls Identity ()
    forall a b. (a -> b) -> a -> b
    $ Body SOACS -> FunCalls
    buildFGBody Body SOACS
    body
                Body SOACS -> WriterT FunCalls Identity (Body SOACS)
    forall a. a -> WriterT FunCalls Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Body SOACS
    body
            }

    instance Pretty FunCalls where
      pretty :: forall ann. FunCalls -> Doc ann
    pretty = [Doc ann] -> Doc ann
    forall a. [Doc a] -> Doc a
    stack ([Doc ann] -> Doc ann)
    -> (FunCalls -> [Doc ann]) -> FunCalls -> Doc ann
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((CallId, (Attrs, Name)) -> Doc ann)
    -> [(CallId, (Attrs, Name))] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map (CallId, (Attrs, Name)) -> Doc ann
    forall {a} {a} {a} {ann}.
    (Pretty a, Pretty a, Pretty a) =>
    (a, (a, a)) -> Doc ann
    f ([(CallId, (Attrs, Name))] -> [Doc ann])
    -> (FunCalls -> [(CallId, (Attrs, Name))]) -> FunCalls -> [Doc ann]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map CallId (Attrs, Name) -> [(CallId, (Attrs, Name))]
    forall k a. Map k a -> [(k, a)]
    M.toList (Map CallId (Attrs, Name) -> [(CallId, (Attrs, Name))])
    -> (FunCalls -> Map CallId (Attrs, Name))
    -> FunCalls
    -> [(CallId, (Attrs, Name))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FunCalls -> Map CallId (Attrs, Name)
    fcMap
        where
          f :: (a, (a, a)) -> Doc ann
    f (a
    x, (a
    attrs, a
    y)) = Doc ann
    "=>" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> a -> Doc ann
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty a
    y Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann
    parens (Doc ann
    "at" Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> a -> Doc ann
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty a
    x Doc ann -> Doc ann -> Doc ann
    forall ann. Doc ann -> Doc ann -> Doc ann
    <+> a -> Doc ann
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty a
    attrs)

    instance Pretty CallGraph where
      pretty :: forall ann. CallGraph -> Doc ann
    pretty (CallGraph FunGraph
    fg FunCalls
    cg) =
        [Doc ann] -> Doc ann
    forall a. [Doc a] -> Doc a
    stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
    forall a b. (a -> b) -> a -> b
    $
          Doc ann -> [Doc ann] -> [Doc ann]
    forall ann. Doc ann -> [Doc ann] -> [Doc ann]
    punctuate Doc ann
    forall ann. Doc ann
    line ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
    forall a b. (a -> b) -> a -> b
    $
            (Name, FunCalls) -> Doc ann
    forall {a} {a}. Pretty a => (Name, a) -> Doc a
    ppFunCalls (Name
    "called at top level", FunCalls
    cg) Doc ann -> [Doc ann] -> [Doc ann]
    forall a. a -> [a] -> [a]
    : ((Name, FunCalls) -> Doc ann) -> [(Name, FunCalls)] -> [Doc ann]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, FunCalls) -> Doc ann
    forall {a} {a}. Pretty a => (Name, a) -> Doc a
    ppFunCalls (FunGraph -> [(Name, FunCalls)]
    forall k a. Map k a -> [(k, a)]
    M.toList FunGraph
    fg)
        where
          ppFunCalls :: (Name, a) -> Doc a
    ppFunCalls (Name
    f, a
    fcalls) =
            Name -> Doc a
    forall a ann. Pretty a => a -> Doc ann
    forall ann. Name -> Doc ann
    pretty Name
    f
              Doc a -> Doc a -> Doc a
    forall ann. Doc ann -> Doc ann -> Doc ann
    </> String -> Doc a
    forall ann. String -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty ((Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map (Char -> Char -> Char
    forall a b. a -> b -> a
    const Char
    '=') (Name -> String
    nameToString Name
    f))
              Doc a -> Doc a -> Doc a
    forall ann. Doc ann -> Doc ann -> Doc ann
    </> Int -> Doc a -> Doc a
    forall ann. Int -> Doc ann -> Doc ann
    indent Int
    2 (a -> Doc a
    forall ann. a -> Doc ann
    forall a ann. Pretty a => a -> Doc ann
    pretty a
    fcalls)