    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE PatternSynonyms #-}
    {-# LANGUAGE ViewPatterns #-}
    -- Undo pointfree transformations. Plugin code derived from Pl.hs.
    module Lambdabot.Plugin.Haskell.Pointful (pointfulPlugin) where

    import Lambdabot.Module as Lmb (Module)
    import Lambdabot.Plugin
    import Lambdabot.Util.Parser (withParsed, prettyPrintInLine)

    import Control.Monad
    import Control.Monad.Reader
    import Control.Monad.State
    import Data.Functor.Identity (Identity)
    import Data.Generics
    import qualified Data.Set as S
    import qualified Data.Map as M
    import Data.List
    import Data.Maybe
    import Language.Haskell.Exts.Simple as Hs

    pointfulPlugin :: Lmb.Module ()
    pointfulPlugin :: Module ()
    pointfulPlugin = Module ()
    forall st. Module st
    newModule
        { moduleCmds = return
            [ (command "pointful")
                { aliases = ["pointy","repoint","unpointless","unpl","unpf"]
                , help = say "pointful <expr>. Make code pointier."
                , process = mapM_ say . lines . pointful
                }
            ]
        }

    ---- Utilities ----

    stabilize :: Eq a => (a -> a) -> a -> a
    stabilize :: forall a. Eq a => (a -> a) -> a -> a
    stabilize a -> a
    f a
    x = let x' :: a
    x' = a -> a
    f a
    x in if a
    x' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    x then a
    x else (a -> a) -> a -> a
    forall a. Eq a => (a -> a) -> a -> a
    stabilize a -> a
    f a
    x'

    -- varsBoundHere returns variables bound by top patterns or binders
    varsBoundHere :: Data d => d -> S.Set Name
    varsBoundHere :: forall d. Data d => d -> Set Name
    varsBoundHere (d -> Maybe Pat
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (PVar Name
    name)) = Name -> Set Name
    forall a. a -> Set a
    S.singleton Name
    name
    varsBoundHere (d -> Maybe Match
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (Match Name
    name [Pat]
    _ Rhs
    _ Maybe Binds
    _)) = Name -> Set Name
    forall a. a -> Set a
    S.singleton Name
    name
    varsBoundHere (d -> Maybe Decl
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (PatBind Pat
    pat Rhs
    _ Maybe Binds
    _)) = Pat -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere Pat
    pat
    varsBoundHere (d -> Maybe Exp
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (Exp
    _ :: Exp)) = Set Name
    forall a. Set a
    S.empty
    varsBoundHere d
    d = [Set Name] -> Set Name
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    S.unions ((forall d. Data d => d -> Set Name) -> d -> [Set Name]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    forall u. (forall d. Data d => d -> u) -> d -> [u]
    gmapQ d -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere d
    d)

    -- note: the tempting idea of using a pattern synonym for the frequent
    -- (cast -> Just _) patterns causes compiler crashes with ghc before
    -- version 8; cf. https://ghc.haskell.org/trac/ghc/ticket/11336

    foldFreeVars :: forall a d. Data d => (Name -> S.Set Name -> a) -> ([a] -> a) -> d -> a
    foldFreeVars :: forall a d.
    Data d =>
    (Name -> Set Name -> a) -> ([a] -> a) -> d -> a
    foldFreeVars Name -> Set Name -> a
    var [a] -> a
    sum d
    e = Reader (Set Name) a -> Set Name -> a
    forall r a. Reader r a -> r -> a
    runReader (d -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go d
    e) Set Name
    forall a. Set a
    S.empty where
        go :: forall d. Data d => d -> Reader (S.Set Name) a
        go :: forall d. Data d => d -> Reader (Set Name) a
    go (d -> Maybe Exp
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (Var (UnQual Name
    name))) =
            (Set Name -> a) -> Reader (Set Name) a
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (Name -> Set Name -> a
    var Name
    name)
        go (d -> Maybe Exp
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (Lambda [Pat]
    ps Exp
    exp)) =
            [Set Name] -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b.
    Ord a =>
    [Set a] -> Reader (Set a) b -> Reader (Set a) b
    bind [[Pat] -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere [Pat]
    ps] (Reader (Set Name) a -> Reader (Set Name) a)
    -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b. (a -> b) -> a -> b
    $ Exp -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go Exp
    exp
        go (d -> Maybe Exp
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (Let Binds
    bs Exp
    exp)) =
            [Set Name] -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b.
    Ord a =>
    [Set a] -> Reader (Set a) b -> Reader (Set a) b
    bind [Binds -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere Binds
    bs] (Reader (Set Name) a -> Reader (Set Name) a)
    -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b. (a -> b) -> a -> b
    $ [Reader (Set Name) a] -> Reader (Set Name) a
    forall (m :: * -> *). Monad m => [m a] -> m a
    collect [Binds -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go Binds
    bs, Exp -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go Exp
    exp]
        go (d -> Maybe Alt
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (Alt Pat
    pat Rhs
    exp Maybe Binds
    bs)) =
            [Set Name] -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b.
    Ord a =>
    [Set a] -> Reader (Set a) b -> Reader (Set a) b
    bind [Pat -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere Pat
    pat, Maybe Binds -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere Maybe Binds
    bs] (Reader (Set Name) a -> Reader (Set Name) a)
    -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b. (a -> b) -> a -> b
    $ [Reader (Set Name) a] -> Reader (Set Name) a
    forall (m :: * -> *). Monad m => [m a] -> m a
    collect [Rhs -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go Rhs
    exp, Maybe Binds -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go Maybe Binds
    bs]
        go (d -> Maybe Decl
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (PatBind Pat
    pat Rhs
    exp Maybe Binds
    bs)) =
            [Set Name] -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b.
    Ord a =>
    [Set a] -> Reader (Set a) b -> Reader (Set a) b
    bind [Pat -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere Pat
    pat, Maybe Binds -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere Maybe Binds
    bs] (Reader (Set Name) a -> Reader (Set Name) a)
    -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b. (a -> b) -> a -> b
    $ [Reader (Set Name) a] -> Reader (Set Name) a
    forall (m :: * -> *). Monad m => [m a] -> m a
    collect [Rhs -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go Rhs
    exp, Maybe Binds -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go Maybe Binds
    bs]
        go (d -> Maybe Match
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast -> Just (Match Name
    _ [Pat]
    ps Rhs
    exp Maybe Binds
    bs)) =
            [Set Name] -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b.
    Ord a =>
    [Set a] -> Reader (Set a) b -> Reader (Set a) b
    bind [[Pat] -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere [Pat]
    ps, Maybe Binds -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere Maybe Binds
    bs] (Reader (Set Name) a -> Reader (Set Name) a)
    -> Reader (Set Name) a -> Reader (Set Name) a
    forall a b. (a -> b) -> a -> b
    $ [Reader (Set Name) a] -> Reader (Set Name) a
    forall (m :: * -> *). Monad m => [m a] -> m a
    collect [Rhs -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go Rhs
    exp, Maybe Binds -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go Maybe Binds
    bs]
        go d
    d = [Reader (Set Name) a] -> Reader (Set Name) a
    forall (m :: * -> *). Monad m => [m a] -> m a
    collect ((forall d. Data d => d -> Reader (Set Name) a)
    -> d -> [Reader (Set Name) a]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    forall u. (forall d. Data d => d -> u) -> d -> [u]
    gmapQ d -> Reader (Set Name) a
    forall d. Data d => d -> Reader (Set Name) a
    go d
    d)

        collect :: forall m. Monad m => [m a] -> m a
        collect :: forall (m :: * -> *). Monad m => [m a] -> m a
    collect [m a]
    ms = [a] -> a
    sum ([a] -> a) -> m [a] -> m a
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` [m a] -> m [a]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [m a]
    ms

        bind :: forall a b. Ord a => [S.Set a] -> Reader (S.Set a) b -> Reader (S.Set a) b
        bind :: forall a b.
    Ord a =>
    [Set a] -> Reader (Set a) b -> Reader (Set a) b
    bind [Set a]
    ss = (Set a -> Set a)
    -> ReaderT (Set a) Identity b -> ReaderT (Set a) Identity b
    forall a.
    (Set a -> Set a)
    -> ReaderT (Set a) Identity a -> ReaderT (Set a) Identity a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ([Set a] -> Set a
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    S.unions [Set a]
    ss Set a -> Set a -> Set a
    forall a. Ord a => Set a -> Set a -> Set a
    `S.union`)

    -- return free variables
    freeVars :: Data d => d -> S.Set Name
    freeVars :: forall d. Data d => d -> Set Name
    freeVars = (Name -> Set Name -> Set Name)
    -> ([Set Name] -> Set Name) -> d -> Set Name
    forall a d.
    Data d =>
    (Name -> Set Name -> a) -> ([a] -> a) -> d -> a
    foldFreeVars (\Name
    name Set Name
    bv -> Name -> Set Name
    forall a. a -> Set a
    S.singleton Name
    name Set Name -> Set Name -> Set Name
    forall a. Ord a => Set a -> Set a -> Set a
    `S.difference` Set Name
    bv) [Set Name] -> Set Name
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    S.unions

    -- return number of free occurrences of a variable
    countOcc :: Data d => Name -> d -> Int
    countOcc :: forall d. Data d => Name -> d -> Int
    countOcc Name
    name = (Name -> Set Name -> Int) -> ([Int] -> Int) -> d -> Int
    forall a d.
    Data d =>
    (Name -> Set Name -> a) -> ([a] -> a) -> d -> a
    foldFreeVars Name -> Set Name -> Int
    forall {a}. Num a => Name -> Set Name -> a
    var [Int] -> Int
    sum where
        sum :: [Int] -> Int
    sum = (Int -> Int -> Int) -> Int -> [Int] -> Int
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) Int
    0
        var :: Name -> Set Name -> a
    var Name
    name' Set Name
    bv = if Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name
    name' Bool -> Bool -> Bool
    || Name
    name' Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set Name
    bv then a
    0 else a
    1

    -- variable capture avoiding substitution
    substAvoiding :: Data d => M.Map Name Exp -> S.Set Name -> d -> d
    substAvoiding :: forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst Set Name
    bv = d -> d
    forall d. Data d => d -> d
    base (d -> d) -> (Exp -> Exp) -> d -> d
    forall a b.
    (Typeable a, Typeable b) =>
    (a -> a) -> (b -> b) -> a -> a
    `extT` Exp -> Exp
    exp (d -> d) -> (Alt -> Alt) -> d -> d
    forall a b.
    (Typeable a, Typeable b) =>
    (a -> a) -> (b -> b) -> a -> a
    `extT` Alt -> Alt
    alt (d -> d) -> (Decl -> Decl) -> d -> d
    forall a b.
    (Typeable a, Typeable b) =>
    (a -> a) -> (b -> b) -> a -> a
    `extT` Decl -> Decl
    decl (d -> d) -> (Match -> Match) -> d -> d
    forall a b.
    (Typeable a, Typeable b) =>
    (a -> a) -> (b -> b) -> a -> a
    `extT` Match -> Match
    match where
        base :: Data d => d -> d
        base :: forall d. Data d => d -> d
    base = (forall d. Data d => d -> d) -> d -> d
    forall a. Data a => (forall d. Data d => d -> d) -> a -> a
    gmapT (Map Name Exp -> Set Name -> b -> b
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst Set Name
    bv)

        exp :: Exp -> Exp
    exp e :: Exp
    e@(Var (UnQual Name
    name)) =
            Exp -> Maybe Exp -> Exp
    forall a. a -> Maybe a -> a
    fromMaybe Exp
    e (Name -> Map Name Exp -> Maybe Exp
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    name Map Name Exp
    subst)
        exp (Lambda [Pat]
    ps Exp
    exp) =
            let (Map Name Exp
    subst', Set Name
    bv', [Pat]
    ps') = Map Name Exp
    -> Set Name -> [Pat] -> (Map Name Exp, Set Name, [Pat])
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    subst Set Name
    bv [Pat]
    ps
            in  [Pat] -> Exp -> Exp
    Lambda [Pat]
    ps' (Map Name Exp -> Set Name -> Exp -> Exp
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst' Set Name
    bv' Exp
    exp)
        exp (Let Binds
    bs Exp
    exp) =
            let (Map Name Exp
    subst', Set Name
    bv', Binds
    bs') = Map Name Exp
    -> Set Name -> Binds -> (Map Name Exp, Set Name, Binds)
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    subst Set Name
    bv Binds
    bs
            in  Binds -> Exp -> Exp
    Let (Map Name Exp -> Set Name -> Binds -> Binds
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst' Set Name
    bv' Binds
    bs') (Map Name Exp -> Set Name -> Exp -> Exp
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst' Set Name
    bv' Exp
    exp)
        exp Exp
    d = Exp -> Exp
    forall d. Data d => d -> d
    base Exp
    d

        alt :: Alt -> Alt
    alt (Alt Pat
    pat Rhs
    exp Maybe Binds
    bs) =
            let (Map Name Exp
    subst1, Set Name
    bv1, Pat
    pat') = Map Name Exp -> Set Name -> Pat -> (Map Name Exp, Set Name, Pat)
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    subst Set Name
    bv Pat
    pat
                (Map Name Exp
    subst', Set Name
    bv', Maybe Binds
    bs') = Map Name Exp
    -> Set Name -> Maybe Binds -> (Map Name Exp, Set Name, Maybe Binds)
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    subst1 Set Name
    bv1 Maybe Binds
    bs
            in  Pat -> Rhs -> Maybe Binds -> Alt
    Alt Pat
    pat' (Map Name Exp -> Set Name -> Rhs -> Rhs
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst' Set Name
    bv' Rhs
    exp) (Map Name Exp -> Set Name -> Maybe Binds -> Maybe Binds
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst' Set Name
    bv' Maybe Binds
    bs')

        decl :: Decl -> Decl
    decl (PatBind Pat
    pat Rhs
    exp Maybe Binds
    bs) =
            let (Map Name Exp
    subst', Set Name
    bv', Maybe Binds
    bs') = Map Name Exp
    -> Set Name -> Maybe Binds -> (Map Name Exp, Set Name, Maybe Binds)
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    subst Set Name
    bv Maybe Binds
    bs in
            Pat -> Rhs -> Maybe Binds -> Decl
    PatBind Pat
    pat (Map Name Exp -> Set Name -> Rhs -> Rhs
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst' Set Name
    bv' Rhs
    exp) (Map Name Exp -> Set Name -> Maybe Binds -> Maybe Binds
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst' Set Name
    bv' Maybe Binds
    bs')
        decl Decl
    d = Decl -> Decl
    forall d. Data d => d -> d
    base Decl
    d

        match :: Match -> Match
    match (Match Name
    name [Pat]
    ps Rhs
    exp Maybe Binds
    bs) =
            let (Map Name Exp
    subst1, Set Name
    bv1, [Pat]
    ps') = Map Name Exp
    -> Set Name -> [Pat] -> (Map Name Exp, Set Name, [Pat])
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    subst Set Name
    bv [Pat]
    ps
                (Map Name Exp
    subst', Set Name
    bv', Maybe Binds
    bs') = Map Name Exp
    -> Set Name -> Maybe Binds -> (Map Name Exp, Set Name, Maybe Binds)
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    subst1 Set Name
    bv1 Maybe Binds
    bs
            in  Name -> [Pat] -> Rhs -> Maybe Binds -> Match
    Match Name
    name [Pat]
    ps' (Map Name Exp -> Set Name -> Rhs -> Rhs
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst' Set Name
    bv' Rhs
    exp) (Map Name Exp -> Set Name -> Maybe Binds -> Maybe Binds
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst' Set Name
    bv' Maybe Binds
    bs')

    -- rename local binders (but not the nested expressions)
    renameBinds :: Data d => M.Map Name Exp -> S.Set Name -> d -> (M.Map Name Exp, S.Set Name, d)
    renameBinds :: forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    subst Set Name
    bv d
    d = (Map Name Exp
    subst', Set Name
    bv', d
    d') where
        (d
    d', (Map Name Exp
    subst', Set Name
    bv', Map Name Name
    _)) = State (Map Name Exp, Set Name, Map Name Name) d
    -> (Map Name Exp, Set Name, Map Name Name)
    -> (d, (Map Name Exp, Set Name, Map Name Name))
    forall s a. State s a -> s -> (a, s)
    runState (d -> State (Map Name Exp, Set Name, Map Name Name) d
    forall d.
    Data d =>
    d -> State (Map Name Exp, Set Name, Map Name Name) d
    go d
    d) (Map Name Exp
    subst, Set Name
    bv, Map Name Name
    forall k a. Map k a
    M.empty)

        go, base :: Data d => d -> State (M.Map Name Exp, S.Set Name, M.Map Name Name) d
        go :: forall d.
    Data d =>
    d -> State (Map Name Exp, Set Name, Map Name Name) d
    go = d -> State (Map Name Exp, Set Name, Map Name Name) d
    forall d.
    Data d =>
    d -> State (Map Name Exp, Set Name, Map Name Name) d
    base (d -> State (Map Name Exp, Set Name, Map Name Name) d)
    -> (Pat
        -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Pat)
    -> d
    -> State (Map Name Exp, Set Name, Map Name Name) d
    forall (m :: * -> *) a b.
    (Monad m, Typeable a, Typeable b) =>
    (a -> m a) -> (b -> m b) -> a -> m a
    `extM` Pat -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Pat
    pat (d -> State (Map Name Exp, Set Name, Map Name Name) d)
    -> (Match
        -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Match)
    -> d
    -> State (Map Name Exp, Set Name, Map Name Name) d
    forall (m :: * -> *) a b.
    (Monad m, Typeable a, Typeable b) =>
    (a -> m a) -> (b -> m b) -> a -> m a
    `extM` Match
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Match
    match (d -> State (Map Name Exp, Set Name, Map Name Name) d)
    -> (Decl
        -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Decl)
    -> d
    -> State (Map Name Exp, Set Name, Map Name Name) d
    forall (m :: * -> *) a b.
    (Monad m, Typeable a, Typeable b) =>
    (a -> m a) -> (b -> m b) -> a -> m a
    `extM` Decl
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Decl
    decl (d -> State (Map Name Exp, Set Name, Map Name Name) d)
    -> (Exp
        -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Exp)
    -> d
    -> State (Map Name Exp, Set Name, Map Name Name) d
    forall (m :: * -> *) a b.
    (Monad m, Typeable a, Typeable b) =>
    (a -> m a) -> (b -> m b) -> a -> m a
    `extM` Exp -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Exp
    forall {m :: * -> *}. Monad m => Exp -> m Exp
    exp
        base :: forall d.
    Data d =>
    d -> State (Map Name Exp, Set Name, Map Name Name) d
    base d
    d = (forall d.
     Data d =>
     d -> State (Map Name Exp, Set Name, Map Name Name) d)
    -> d -> StateT (Map Name Exp, Set Name, Map Name Name) Identity d
    forall a (m :: * -> *).
    (Data a, Monad m) =>
    (forall d. Data d => d -> m d) -> a -> m a
    forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> d -> m d
    gmapM d -> State (Map Name Exp, Set Name, Map Name Name) d
    forall d.
    Data d =>
    d -> State (Map Name Exp, Set Name, Map Name Name) d
    go d
    d

        pat :: Pat -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Pat
    pat (PVar Name
    name) = Name -> Pat
    PVar (Name -> Pat)
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Name
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Pat
    forall a b.
    (a -> b)
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity a
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Name
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Name
    rename Name
    name
        pat Pat
    d = Pat -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Pat
    forall d.
    Data d =>
    d -> State (Map Name Exp, Set Name, Map Name Name) d
    base Pat
    d

        match :: Match
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Match
    match (Match Name
    name [Pat]
    ps Rhs
    exp Maybe Binds
    bs) = do
            name' <- Name
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Name
    rename Name
    name
            return $ Match name' ps exp bs

        decl :: Decl
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Decl
    decl (PatBind Pat
    pat Rhs
    exp Maybe Binds
    bs) = do
            pat' <- Pat -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Pat
    forall d.
    Data d =>
    d -> State (Map Name Exp, Set Name, Map Name Name) d
    go Pat
    pat
            return $ PatBind pat' exp bs
        decl Decl
    d = Decl
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Decl
    forall d.
    Data d =>
    d -> State (Map Name Exp, Set Name, Map Name Name) d
    base Decl
    d

        exp :: Exp -> m Exp
    exp (Exp
    e :: Exp) = Exp -> m Exp
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    e

        rename :: Name -> State (M.Map Name Exp, S.Set Name, M.Map Name Name) Name
        rename :: Name
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Name
    rename Name
    name = do
            (subst, bv, ass) <- StateT
      (Map Name Exp, Set Name, Map Name Name)
      Identity
      (Map Name Exp, Set Name, Map Name Name)
    forall s (m :: * -> *). MonadState s m => m s
    get
            case (name `M.lookup` ass, name `S.member` bv) of
                (Just Name
    name', Bool
    _) -> do
                     Name
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Name
    forall a.
    a -> StateT (Map Name Exp, Set Name, Map Name Name) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    name'
                (Maybe Name
    _, Bool
    False) -> do
                    (Map Name Exp, Set Name, Map Name Name)
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (Name -> Map Name Exp -> Map Name Exp
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Name
    name Map Name Exp
    subst, Name -> Set Name -> Set Name
    forall a. Ord a => a -> Set a -> Set a
    S.insert Name
    name Set Name
    bv, Map Name Name
    ass)
                    Name
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Name
    forall a.
    a -> StateT (Map Name Exp, Set Name, Map Name Name) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    name
                (Maybe Name, Bool)
    _ -> do
                    let name' :: Name
    name' = Name -> Set Name -> Name
    freshNameAvoiding Name
    name Set Name
    bv
                    (Map Name Exp, Set Name, Map Name Name)
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (Name -> Exp -> Map Name Exp -> Map Name Exp
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Name
    name (QName -> Exp
    Var (Name -> QName
    UnQual Name
    name')) Map Name Exp
    subst,
                         Name -> Set Name -> Set Name
    forall a. Ord a => a -> Set a -> Set a
    S.insert Name
    name' Set Name
    bv, Name -> Name -> Map Name Name -> Map Name Name
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Name
    name Name
    name' Map Name Name
    ass)
                    Name
    -> StateT (Map Name Exp, Set Name, Map Name Name) Identity Name
    forall a.
    a -> StateT (Map Name Exp, Set Name, Map Name Name) Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    name'

    -- generate fresh names
    freshNameAvoiding :: Name -> S.Set Name -> Name
    freshNameAvoiding :: Name -> Set Name -> Name
    freshNameAvoiding Name
    name Set Name
    forbidden  = String -> Name
    con (String
    pre String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    suf) where
        (String -> Name
    con, String
    nm, String
    cs) = case Name
    name of
             Ident  String
    n -> (String -> Name
    Ident,  String
    n, String
    "0123456789")
             Symbol String
    n -> (String -> Name
    Symbol, String
    n, String
    "?#")
        pre :: String
    pre = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    cs) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    nm
        sufs :: [String]
    sufs = [Int
    1..] [Int] -> (Int -> [String]) -> [String]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Int -> String -> [String]) -> String -> Int -> [String]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Int -> String -> [String]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM String
    cs
        suf :: String
    suf = [String] -> String
    forall a. HasCallStack => [a] -> a
    head ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (\String
    suf -> String -> Name
    con (String
    pre String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    suf) Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set Name
    forbidden) [String]
    sufs

    ---- Optimization (removing explicit lambdas) and restoration of infix ops ----

    -- move lambda patterns into LHS
    optimizeD :: Decl -> Decl
    optimizeD :: Decl -> Decl
    optimizeD (PatBind (PVar Name
    fname) (UnGuardedRhs (Lambda [Pat]
    pats Exp
    rhs)) Maybe Binds
    Nothing) =
        let (Map Name Exp
    subst, Set Name
    bv, [Pat]
    pats') = Map Name Exp
    -> Set Name -> [Pat] -> (Map Name Exp, Set Name, [Pat])
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    forall k a. Map k a
    M.empty (Name -> Set Name
    forall a. a -> Set a
    S.singleton Name
    fname) [Pat]
    pats
            rhs' :: Exp
    rhs' = Map Name Exp -> Set Name -> Exp -> Exp
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst Set Name
    bv Exp
    rhs
        in  [Match] -> Decl
    FunBind [Name -> [Pat] -> Rhs -> Maybe Binds -> Match
    Match Name
    fname [Pat]
    pats' (Exp -> Rhs
    UnGuardedRhs Exp
    rhs') Maybe Binds
    forall a. Maybe a
    Nothing]
    ---- combine function binding and lambda
    optimizeD (FunBind [Match Name
    fname [Pat]
    pats1 (UnGuardedRhs (Lambda [Pat]
    pats2 Exp
    rhs)) Maybe Binds
    Nothing]) =
        let (Map Name Exp
    subst, Set Name
    bv, [Pat]
    pats2') = Map Name Exp
    -> Set Name -> [Pat] -> (Map Name Exp, Set Name, [Pat])
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    forall k a. Map k a
    M.empty ([Pat] -> Set Name
    forall d. Data d => d -> Set Name
    varsBoundHere [Pat]
    pats1) [Pat]
    pats2
            rhs' :: Exp
    rhs' = Map Name Exp -> Set Name -> Exp -> Exp
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst Set Name
    bv Exp
    rhs
        in  [Match] -> Decl
    FunBind [Name -> [Pat] -> Rhs -> Maybe Binds -> Match
    Match Name
    fname ([Pat]
    pats1 [Pat] -> [Pat] -> [Pat]
    forall a. [a] -> [a] -> [a]
    ++ [Pat]
    pats2') (Exp -> Rhs
    UnGuardedRhs Exp
    rhs') Maybe Binds
    forall a. Maybe a
    Nothing]
    optimizeD Decl
    x = Decl
    x

    -- remove parens
    optimizeRhs :: Rhs -> Rhs
    optimizeRhs :: Rhs -> Rhs
    optimizeRhs (UnGuardedRhs (Paren Exp
    x)) = Exp -> Rhs
    UnGuardedRhs Exp
    x
    optimizeRhs Rhs
    x = Rhs
    x

    optimizeE :: Exp -> Exp
    -- apply ((\x z -> ...x...) y) yielding (\z -> ...y...) if there is only one x or y is simple
    optimizeE :: Exp -> Exp
    optimizeE (App (Lambda (PVar Name
    ident : [Pat]
    pats) Exp
    body) Exp
    arg) | Bool
    single Bool -> Bool -> Bool
    || Exp -> Bool
    simple Exp
    arg =
         let (Map Name Exp
    subst, Set Name
    bv, [Pat]
    pats') = Map Name Exp
    -> Set Name -> [Pat] -> (Map Name Exp, Set Name, [Pat])
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds (Name -> Exp -> Map Name Exp
    forall k a. k -> a -> Map k a
    M.singleton Name
    ident Exp
    arg) (Exp -> Set Name
    forall d. Data d => d -> Set Name
    freeVars Exp
    arg) [Pat]
    pats
         in  Exp -> Exp
    Paren ([Pat] -> Exp -> Exp
    Lambda [Pat]
    pats' (Map Name Exp -> Set Name -> Exp -> Exp
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst Set Name
    bv Exp
    body))
      where
        single :: Bool
    single = Name -> Exp -> Int
    forall d. Data d => Name -> d -> Int
    countOcc Name
    ident Exp
    body Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1
        simple :: Exp -> Bool
    simple Exp
    e = case Exp
    e of Var QName
    _ -> Bool
    True; Lit Literal
    _ -> Bool
    True; Paren Exp
    e' -> Exp -> Bool
    simple Exp
    e'; Exp
    _ -> Bool
    False
    -- apply ((\_ z -> ...) y) yielding (\z -> ...)
    optimizeE (App (Lambda (Pat
    PWildCard : [Pat]
    pats) Exp
    body) Exp
    _) =
        Exp -> Exp
    Paren ([Pat] -> Exp -> Exp
    Lambda [Pat]
    pats Exp
    body)
    -- remove 0-arg lambdas resulting from application rules
    optimizeE (Lambda [] Exp
    b) =
        Exp
    b
    -- replace (\x -> \y -> z) with (\x y -> z)
    optimizeE (Lambda [Pat]
    p1 (Lambda [Pat]
    p2 Exp
    body)) =
        let (Map Name Exp
    subst, Set Name
    bv, [Pat]
    p2') = Map Name Exp
    -> Set Name -> [Pat] -> (Map Name Exp, Set Name, [Pat])
    forall d.
    Data d =>
    Map Name Exp -> Set Name -> d -> (Map Name Exp, Set Name, d)
    renameBinds Map Name Exp
    forall k a. Map k a
    M.empty (Exp -> Set Name
    forall d. Data d => d -> Set Name
    freeVars ([Pat] -> Exp -> Exp
    Lambda [Pat]
    p2 Exp
    body)) [Pat]
    p2
            body' :: Exp
    body' = Map Name Exp -> Set Name -> Exp -> Exp
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    subst Set Name
    bv Exp
    body
        in  [Pat] -> Exp -> Exp
    Lambda ([Pat]
    p1 [Pat] -> [Pat] -> [Pat]
    forall a. [a] -> [a] -> [a]
    ++ [Pat]
    p2') Exp
    body'
    -- remove double parens
    optimizeE (Paren (Paren Exp
    x)) =
        Exp -> Exp
    Paren Exp
    x
    -- remove parens around applied lambdas (the pretty printer restores them)
    optimizeE (App (Paren (x :: Exp
    x@Lambda{})) Exp
    y) =
        Exp -> Exp -> Exp
    App Exp
    x Exp
    y
    -- remove lambda body parens
    optimizeE (Lambda [Pat]
    p (Paren Exp
    x)) =
        [Pat] -> Exp -> Exp
    Lambda [Pat]
    p Exp
    x
    -- remove var, lit parens
    optimizeE (Paren x :: Exp
    x@(Var QName
    _)) =
        Exp
    x
    optimizeE (Paren x :: Exp
    x@(Lit Literal
    _)) =
        Exp
    x
    -- remove infix+lambda parens
    optimizeE (InfixApp Exp
    a QOp
    o (Paren l :: Exp
    l@(Lambda [Pat]
    _ Exp
    _))) =
        Exp -> QOp -> Exp -> Exp
    InfixApp Exp
    a QOp
    o Exp
    l
    -- remove infix+app aprens
    optimizeE (InfixApp (Paren a :: Exp
    a@App{}) QOp
    o Exp
    l) =
        Exp -> QOp -> Exp -> Exp
    InfixApp Exp
    a QOp
    o Exp
    l
    optimizeE (InfixApp Exp
    a QOp
    o (Paren l :: Exp
    l@App{})) =
        Exp -> QOp -> Exp -> Exp
    InfixApp Exp
    a QOp
    o Exp
    l
    -- remove left-assoc application parens
    optimizeE (App (Paren (App Exp
    a Exp
    b)) Exp
    c) =
        Exp -> Exp -> Exp
    App (Exp -> Exp -> Exp
    App Exp
    a Exp
    b) Exp
    c
    -- restore infix
    optimizeE (App (App (Var name' :: QName
    name'@(UnQual (Symbol String
    _))) Exp
    l) Exp
    r) =
        (Exp -> QOp -> Exp -> Exp
    InfixApp Exp
    l (QName -> QOp
    QVarOp QName
    name') Exp
    r)
    -- eta reduce
    optimizeE (Lambda ps :: [Pat]
    ps@(Pat
    _:[Pat]
    _) (App Exp
    e (Var (UnQual Name
    v))))
        | Bool
    free Bool -> Bool -> Bool
    && [Pat] -> Pat
    forall a. HasCallStack => [a] -> a
    last [Pat]
    ps Pat -> Pat -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> Pat
    PVar Name
    v = [Pat] -> Exp -> Exp
    Lambda ([Pat] -> [Pat]
    forall a. HasCallStack => [a] -> [a]
    init [Pat]
    ps) Exp
    e
      where free :: Bool
    free = Name -> Exp -> Int
    forall d. Data d => Name -> d -> Int
    countOcc Name
    v Exp
    e Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
    -- fail
    optimizeE Exp
    x = Exp
    x

    ---- Decombinatorization ----

    uncomb' :: Exp -> Exp

    uncomb' :: Exp -> Exp
    uncomb' (Paren (Paren Exp
    e)) = Exp -> Exp
    Paren Exp
    e

    -- eliminate sections
    uncomb' (RightSection QOp
    op' Exp
    arg) =
        let a :: Name
    a = Name -> Set Name -> Name
    freshNameAvoiding (String -> Name
    Ident String
    "a") (Exp -> Set Name
    forall d. Data d => d -> Set Name
    freeVars Exp
    arg)
        in  (Exp -> Exp
    Paren ([Pat] -> Exp -> Exp
    Lambda [Name -> Pat
    PVar Name
    a] (Exp -> QOp -> Exp -> Exp
    InfixApp (QName -> Exp
    Var (Name -> QName
    UnQual Name
    a)) QOp
    op' Exp
    arg)))
    uncomb' (LeftSection Exp
    arg QOp
    op') =
        let a :: Name
    a = Name -> Set Name -> Name
    freshNameAvoiding (String -> Name
    Ident String
    "a") (Exp -> Set Name
    forall d. Data d => d -> Set Name
    freeVars Exp
    arg)
        in  (Exp -> Exp
    Paren ([Pat] -> Exp -> Exp
    Lambda [Name -> Pat
    PVar Name
    a] (Exp -> QOp -> Exp -> Exp
    InfixApp Exp
    arg QOp
    op' (QName -> Exp
    Var (Name -> QName
    UnQual Name
    a)))))
    -- infix to prefix for canonicality
    uncomb' (InfixApp Exp
    lf (QVarOp QName
    name') Exp
    rf) =
        (Exp -> Exp
    Paren (Exp -> Exp -> Exp
    App (Exp -> Exp -> Exp
    App (QName -> Exp
    Var QName
    name') (Exp -> Exp
    Paren Exp
    lf)) (Exp -> Exp
    Paren Exp
    rf)))

    -- Expand (>>=) when it is obviously the reader monad:

    -- rewrite: (>>=) (\x -> e)
    -- to:      (\ a b -> a ((\ x -> e) b) b)
    uncomb' (App (Var (UnQual (Symbol String
    ">>="))) (Paren lam :: Exp
    lam@Lambda{})) =
       let a :: Name
    a = Name -> Set Name -> Name
    freshNameAvoiding (String -> Name
    Ident String
    "a") (Exp -> Set Name
    forall d. Data d => d -> Set Name
    freeVars Exp
    lam)
           b :: Name
    b = Name -> Set Name -> Name
    freshNameAvoiding (String -> Name
    Ident String
    "b") (Exp -> Set Name
    forall d. Data d => d -> Set Name
    freeVars Exp
    lam)
       in  (Exp -> Exp
    Paren ([Pat] -> Exp -> Exp
    Lambda [Name -> Pat
    PVar Name
    a, Name -> Pat
    PVar Name
    b]
               (Exp -> Exp -> Exp
    App (Exp -> Exp -> Exp
    App (QName -> Exp
    Var (Name -> QName
    UnQual Name
    a)) (Exp -> Exp
    Paren (Exp -> Exp -> Exp
    App Exp
    lam (QName -> Exp
    Var (Name -> QName
    UnQual Name
    b))))) (QName -> Exp
    Var (Name -> QName
    UnQual Name
    b)))))
    -- rewrite: ((>>=) e1) (\x y -> e2)
    -- to:      (\a -> (\x y -> e2) (e1 a) a)
    uncomb' (App (App (Var (UnQual (Symbol String
    ">>="))) Exp
    e1) (Paren lam :: Exp
    lam@(Lambda (Pat
    _:Pat
    _:[Pat]
    _) Exp
    _))) =
        let a :: Name
    a = Name -> Set Name -> Name
    freshNameAvoiding (String -> Name
    Ident String
    "a") ([Exp] -> Set Name
    forall d. Data d => d -> Set Name
    freeVars [Exp
    e1,Exp
    lam])
        in  (Exp -> Exp
    Paren ([Pat] -> Exp -> Exp
    Lambda [Name -> Pat
    PVar Name
    a]
                (Exp -> Exp -> Exp
    App (Exp -> Exp -> Exp
    App Exp
    lam (Exp -> Exp -> Exp
    App Exp
    e1 (QName -> Exp
    Var (Name -> QName
    UnQual Name
    a)))) (QName -> Exp
    Var (Name -> QName
    UnQual Name
    a)))))

    -- fail
    uncomb' Exp
    expr = Exp
    expr

    ---- Simple combinator definitions ---
    combinators :: M.Map Name Exp
    combinators :: Map Name Exp
    combinators = [(Name, Exp)] -> Map Name Exp
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Name, Exp)] -> Map Name Exp) -> [(Name, Exp)] -> Map Name Exp
    forall a b. (a -> b) -> a -> b
    $ (Decl -> (Name, Exp)) -> [Decl] -> [(Name, Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    map Decl -> (Name, Exp)
    declToTuple [Decl]
    defs
      where defs :: [Decl]
    defs = case String -> ParseResult Module
    parseModule String
    combinatorModule of
              ParseOk (Hs.Module Maybe ModuleHead
    _ [ModulePragma]
    _ [ImportDecl]
    _ [Decl]
    d) -> [Decl]
    d
              f :: ParseResult Module
    f@(ParseFailed SrcLoc
    _ String
    _) -> String -> [Decl]
    forall a. HasCallStack => String -> a
    error (String
    "Combinator loading: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ParseResult Module -> String
    forall a. Show a => a -> String
    show ParseResult Module
    f)
            declToTuple :: Decl -> (Name, Exp)
    declToTuple (PatBind (PVar Name
    fname) (UnGuardedRhs Exp
    body) Maybe Binds
    Nothing)
              = (Name
    fname, Exp -> Exp
    Paren Exp
    body)
            declToTuple Decl
    _ = String -> (Name, Exp)
    forall a. HasCallStack => String -> a
    error String
    "Pointful Plugin error: can't convert declaration to tuple"

    combinatorModule :: String
    combinatorModule :: String
    combinatorModule = [String] -> String
    unlines [
      String
    "(.)    = \\f g x -> f (g x)                                          ",
      String
    "($)    = \\f x   -> f x                                              ",
      String
    "flip   = \\f x y -> f y x                                            ",
      String
    "const  = \\x _ -> x                                                  ",
      String
    "id     = \\x -> x                                                    ",
      String
    "(=<<)  = flip (>>=)                                                  ",
      String
    "liftM2 = \\f m1 m2 -> m1 >>= \\x1 -> m2 >>= \\x2 -> return (f x1 x2) ",
      String
    "join   = (>>= id)                                                    ",
      String
    "ap     = liftM2 id                                                   ",
      String
    "(>=>)  = flip (<=<)                                                  ",
      String
    "(<=<)  = \\f g x -> f >>= g x                                        ",
      String
    "                                                                     ",
      String
    "-- ASSUMED reader monad                                              ",
      String
    "-- (>>=)  = (\\f k r -> k (f r) r)                                   ",
      String
    "-- return = const                                                    ",
      String
    ""]

    ---- Top level ----

    unfoldCombinators :: (Data a) => a -> a
    unfoldCombinators :: forall d. Data d => d -> d
    unfoldCombinators = Map Name Exp -> Set Name -> a -> a
    forall d. Data d => Map Name Exp -> Set Name -> d -> d
    substAvoiding Map Name Exp
    combinators (Map Name Exp -> Set Name
    forall d. Data d => d -> Set Name
    freeVars Map Name Exp
    combinators)

    uncombOnce :: (Data a) => a -> a
    uncombOnce :: forall d. Data d => d -> d
    uncombOnce a
    x = (forall d. Data d => d -> d) -> forall d. Data d => d -> d
    everywhere ((Exp -> Exp) -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT Exp -> Exp
    uncomb') a
    x
    uncomb :: (Eq a, Data a) => a -> a
    uncomb :: forall a. (Eq a, Data a) => a -> a
    uncomb = (a -> a) -> a -> a
    forall a. Eq a => (a -> a) -> a -> a
    stabilize a -> a
    forall d. Data d => d -> d
    uncombOnce

    optimizeOnce :: (Data a) => a -> a
    optimizeOnce :: forall d. Data d => d -> d
    optimizeOnce a
    x = (forall d. Data d => d -> d) -> forall d. Data d => d -> d
    everywhere ((Decl -> Decl) -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT Decl -> Decl
    optimizeD (a -> a) -> (Rhs -> Rhs) -> a -> a
    forall a b.
    (Typeable a, Typeable b) =>
    (a -> a) -> (b -> b) -> a -> a
    `extT` Rhs -> Rhs
    optimizeRhs (a -> a) -> (Exp -> Exp) -> a -> a
    forall a b.
    (Typeable a, Typeable b) =>
    (a -> a) -> (b -> b) -> a -> a
    `extT` Exp -> Exp
    optimizeE) a
    x
    optimize :: (Eq a, Data a) => a -> a
    optimize :: forall a. (Eq a, Data a) => a -> a
    optimize = (a -> a) -> a -> a
    forall a. Eq a => (a -> a) -> a -> a
    stabilize a -> a
    forall d. Data d => d -> d
    optimizeOnce

    pointful :: String -> String
    pointful :: String -> String
    pointful = (forall a. (Data a, Eq a) => a -> a) -> String -> String
    withParsed ((a -> a) -> a -> a
    forall a. Eq a => (a -> a) -> a -> a
    stabilize (a -> a
    forall a. (Eq a, Data a) => a -> a
    optimize (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> a
    forall a. (Eq a, Data a) => a -> a
    uncomb) (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> a) -> a -> a
    forall a. Eq a => (a -> a) -> a -> a
    stabilize (a -> a
    forall d. Data d => d -> d
    unfoldCombinators (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> a
    forall a. (Eq a, Data a) => a -> a
    uncomb))

    -- TODO: merge this into a proper test suite once one exists
    -- test s = case parseModule s of
    --   f@(ParseFailed _ _) -> fail (show f)
    --   ParseOk (Hs.Module _ _ _ _ _ _ defs) ->
    --     flip mapM_ defs $ \def -> do
    --       putStrLn . prettyPrintInLine  $ def
    --       putStrLn . prettyPrintInLine  . uncomb $ def
    --       putStrLn . prettyPrintInLine  . optimize . uncomb $ def
    --       putStrLn . prettyPrintInLine  . stabilize (optimize . uncomb) $ def
    --       putStrLn ""
    --
    -- main = test "f = tail . head; g = head . tail; h = tail + tail; three = g . h . i; dontSub = (\\x -> x + x) 1; ofHead f = f . head; fm = flip mapM_ xs (\\x -> g x); po = (+1); op = (1+); g = (. f); stabilize = fix (ap . flip (ap . (flip =<< (if' .) . (==))) =<<)"
    --