    {-# OPTIONS -w #-}

    module Lambdabot.Plugin.Haskell.Free.Expr where

    import Lambdabot.Plugin.Haskell.Free.Type
    import Lambdabot.Plugin.Haskell.Free.Util

    import Prelude hiding ((<>))

    varInExpr :: Var -> Expr -> Bool
    varInExpr :: Var -> Expr -> Bool
    varInExpr Var
    v (EBuiltin Builtin
    _)
        = Bool
    False
    varInExpr Var
    v (EVar Var
    v')
        = Var
    v Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    v'
    varInExpr Var
    v (EVarOp Fixity
    _ Int
    _ Var
    v')
        = Bool
    False
    varInExpr Var
    v (EApp Expr
    e1 Expr
    e2)
        = Var -> Expr -> Bool
    varInExpr Var
    v Expr
    e1 Bool -> Bool -> Bool
    || Var -> Expr -> Bool
    varInExpr Var
    v Expr
    e2
    varInExpr Var
    v (ETyApp Expr
    e1 Type
    t)
        = Var -> Expr -> Bool
    varInExpr Var
    v Expr
    e1

    leftVarOfExpr :: Expr -> Var
    leftVarOfExpr :: Expr -> Var
    leftVarOfExpr (EVar Var
    v) = Var
    v
    leftVarOfExpr (EApp Expr
    e Expr
    _) = Expr -> Var
    leftVarOfExpr Expr
    e
    leftVarOfExpr (ETyApp Expr
    e Type
    _) = Expr -> Var
    leftVarOfExpr Expr
    e

    exprSubst :: Var -> Expr -> Expr -> Expr
    exprSubst :: Var -> Expr -> Expr -> Expr
    exprSubst Var
    v Expr
    e e' :: Expr
    e'@(EBuiltin Builtin
    _)
        = Expr
    e'
    exprSubst Var
    v Expr
    e e' :: Expr
    e'@(EVar Var
    v')
        | Var
    v Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    v'   = Expr
    e
        | Bool
    otherwise = Expr
    e'
    exprSubst Var
    v Expr
    e e' :: Expr
    e'@(EVarOp Fixity
    _ Int
    _ Var
    v')
        | Var
    v Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    v'   = Expr
    e
        | Bool
    otherwise = Expr
    e'
    exprSubst Var
    v Expr
    e (EApp Expr
    e1 Expr
    e2)
        = Expr -> Expr -> Expr
    EApp (Var -> Expr -> Expr -> Expr
    exprSubst Var
    v Expr
    e Expr
    e1) (Var -> Expr -> Expr -> Expr
    exprSubst Var
    v Expr
    e Expr
    e2)
    exprSubst Var
    v Expr
    e (ETyApp Expr
    e1 Type
    t)
        = Expr -> Type -> Expr
    ETyApp (Var -> Expr -> Expr -> Expr
    exprSubst Var
    v Expr
    e Expr
    e1) Type
    t

    type Var = String

    data Fixity
        = FL | FN | FR
        deriving (Fixity -> Fixity -> Bool
    (Fixity -> Fixity -> Bool)
    -> (Fixity -> Fixity -> Bool) -> Eq Fixity
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Fixity -> Fixity -> Bool
    == :: Fixity -> Fixity -> Bool
    $c/= :: Fixity -> Fixity -> Bool
    /= :: Fixity -> Fixity -> Bool
    Eq, Int -> Fixity -> ShowS
    [Fixity] -> ShowS
    Fixity -> Var
    (Int -> Fixity -> ShowS)
    -> (Fixity -> Var) -> ([Fixity] -> ShowS) -> Show Fixity
    forall a.
    (Int -> a -> ShowS) -> (a -> Var) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Fixity -> ShowS
    showsPrec :: Int -> Fixity -> ShowS
    $cshow :: Fixity -> Var
    show :: Fixity -> Var
    $cshowList :: [Fixity] -> ShowS
    showList :: [Fixity] -> ShowS
    Show)

    data Expr
        = EVar Var
        | EBuiltin Builtin
        | EVarOp Fixity Int Var
        | EApp Expr Expr
        | ETyApp Expr Type
            deriving (Expr -> Expr -> Bool
    (Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Expr -> Expr -> Bool
    == :: Expr -> Expr -> Bool
    $c/= :: Expr -> Expr -> Bool
    /= :: Expr -> Expr -> Bool
    Eq, Int -> Expr -> ShowS
    [Expr] -> ShowS
    Expr -> Var
    (Int -> Expr -> ShowS)
    -> (Expr -> Var) -> ([Expr] -> ShowS) -> Show Expr
    forall a.
    (Int -> a -> ShowS) -> (a -> Var) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Expr -> ShowS
    showsPrec :: Int -> Expr -> ShowS
    $cshow :: Expr -> Var
    show :: Expr -> Var
    $cshowList :: [Expr] -> ShowS
    showList :: [Expr] -> ShowS
    Show)

    data Builtin
        = BMap TyName
        | BId
        | BProj Int Int
        | BMapTuple Int
        | BArr
            deriving (Builtin -> Builtin -> Bool
    (Builtin -> Builtin -> Bool)
    -> (Builtin -> Builtin -> Bool) -> Eq Builtin
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Builtin -> Builtin -> Bool
    == :: Builtin -> Builtin -> Bool
    $c/= :: Builtin -> Builtin -> Bool
    /= :: Builtin -> Builtin -> Bool
    Eq, Int -> Builtin -> ShowS
    [Builtin] -> ShowS
    Builtin -> Var
    (Int -> Builtin -> ShowS)
    -> (Builtin -> Var) -> ([Builtin] -> ShowS) -> Show Builtin
    forall a.
    (Int -> a -> ShowS) -> (a -> Var) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Builtin -> ShowS
    showsPrec :: Int -> Builtin -> ShowS
    $cshow :: Builtin -> Var
    show :: Builtin -> Var
    $cshowList :: [Builtin] -> ShowS
    showList :: [Builtin] -> ShowS
    Show)

    data ExprCtx
        = ECDot
        | ECAppL ExprCtx Expr
        | ECAppR Expr ExprCtx
        | ECTyApp ExprCtx Type
            deriving (ExprCtx -> ExprCtx -> Bool
    (ExprCtx -> ExprCtx -> Bool)
    -> (ExprCtx -> ExprCtx -> Bool) -> Eq ExprCtx
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ExprCtx -> ExprCtx -> Bool
    == :: ExprCtx -> ExprCtx -> Bool
    $c/= :: ExprCtx -> ExprCtx -> Bool
    /= :: ExprCtx -> ExprCtx -> Bool
    Eq, Int -> ExprCtx -> ShowS
    [ExprCtx] -> ShowS
    ExprCtx -> Var
    (Int -> ExprCtx -> ShowS)
    -> (ExprCtx -> Var) -> ([ExprCtx] -> ShowS) -> Show ExprCtx
    forall a.
    (Int -> a -> ShowS) -> (a -> Var) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ExprCtx -> ShowS
    showsPrec :: Int -> ExprCtx -> ShowS
    $cshow :: ExprCtx -> Var
    show :: ExprCtx -> Var
    $cshowList :: [ExprCtx] -> ShowS
    showList :: [ExprCtx] -> ShowS
    Show)

    applySimplifierExpr :: (Expr -> Expr) -> (Expr -> Expr)
    applySimplifierExpr :: (Expr -> Expr) -> Expr -> Expr
    applySimplifierExpr Expr -> Expr
    s (EApp Expr
    e1 Expr
    e2)
        = Expr -> Expr -> Expr
    EApp (Expr -> Expr
    s Expr
    e1) (Expr -> Expr
    s Expr
    e2)
    applySimplifierExpr Expr -> Expr
    s (ETyApp Expr
    e Type
    t)
        = Expr -> Type -> Expr
    ETyApp (Expr -> Expr
    s Expr
    e) Type
    t
    applySimplifierExpr Expr -> Expr
    s Expr
    e
        = Expr
    e

    unzipExpr :: Expr -> ExprCtx -> Expr
    unzipExpr :: Expr -> ExprCtx -> Expr
    unzipExpr Expr
    e ExprCtx
    ECDot = Expr
    e
    unzipExpr Expr
    e (ECAppL ExprCtx
    c Expr
    e2) = Expr -> ExprCtx -> Expr
    unzipExpr (Expr -> Expr -> Expr
    EApp Expr
    e Expr
    e2) ExprCtx
    c
    unzipExpr Expr
    e (ECAppR Expr
    e1 ExprCtx
    c) = Expr -> ExprCtx -> Expr
    unzipExpr (Expr -> Expr -> Expr
    EApp Expr
    e1 Expr
    e) ExprCtx
    c
    unzipExpr Expr
    e (ECTyApp ExprCtx
    c Type
    t) = Expr -> ExprCtx -> Expr
    unzipExpr (Expr -> Type -> Expr
    ETyApp Expr
    e Type
    t) ExprCtx
    c

    varInCtx :: Var -> ExprCtx -> Bool
    varInCtx :: Var -> ExprCtx -> Bool
    varInCtx Var
    v ExprCtx
    ECDot
        = Bool
    False
    varInCtx Var
    v (ECAppL ExprCtx
    c Expr
    e2)
        = Var -> ExprCtx -> Bool
    varInCtx Var
    v ExprCtx
    c Bool -> Bool -> Bool
    || Var -> Expr -> Bool
    varInExpr Var
    v Expr
    e2
    varInCtx Var
    v (ECAppR Expr
    e1 ExprCtx
    c)
        = Var -> ExprCtx -> Bool
    varInCtx Var
    v ExprCtx
    c Bool -> Bool -> Bool
    || Var -> Expr -> Bool
    varInExpr Var
    v Expr
    e1
    varInCtx Var
    v (ECTyApp ExprCtx
    c Type
    _)
        = Var -> ExprCtx -> Bool
    varInCtx Var
    v ExprCtx
    c

    precAPP :: Int
    precAPP :: Int
    precAPP = Int
    10

    instance Pretty Expr where
        prettyP :: Int -> Expr -> Doc
    prettyP Int
    p (EBuiltin Builtin
    b)
            = Int -> Builtin -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyP Int
    p Builtin
    b
        prettyP Int
    _ (EVar Var
    v)
            = Var -> Doc
    text Var
    v
        prettyP Int
    _ (EVarOp Fixity
    _ Int
    _ Var
    v)
            = Doc
    lparen Doc -> Doc -> Doc
    <> Var -> Doc
    text Var
    v Doc -> Doc -> Doc
    <> Doc
    rparen
        prettyP Int
    p (EApp (EApp (EVarOp Fixity
    fix Int
    prec Var
    op) Expr
    e1) Expr
    e2)
            = Bool -> Doc -> Doc
    prettyParen (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    prec) (
                Int -> Expr -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyP Int
    pl Expr
    e1 Doc -> Doc -> Doc
    <+> Var -> Doc
    text Var
    op Doc -> Doc -> Doc
    <+> Int -> Expr -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyP Int
    pr Expr
    e2
            )
            where
                pl :: Int
    pl = if Fixity
    fix Fixity -> Fixity -> Bool
    forall a. Eq a => a -> a -> Bool
    == Fixity
    FL then Int
    prec else Int
    precInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1
                pr :: Int
    pr = if Fixity
    fix Fixity -> Fixity -> Bool
    forall a. Eq a => a -> a -> Bool
    == Fixity
    FR then Int
    prec else Int
    precInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1
        prettyP Int
    p (EApp Expr
    e1 Expr
    e2)
            = Bool -> Doc -> Doc
    prettyParen (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    precAPP) (
                Int -> Expr -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyP Int
    precAPP Expr
    e1 Doc -> Doc -> Doc
    <+> Int -> Expr -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyP (Int
    precAPPInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Expr
    e2
            )
        prettyP Int
    p (ETyApp Expr
    e Type
    t)
            = Int -> Expr -> Doc
    forall a. Pretty a => Int -> a -> Doc
    prettyP Int
    precAPP Expr
    e

    instance Pretty Builtin where
        prettyP :: Int -> Builtin -> Doc
    prettyP Int
    p (BMap Var
    "[]")   = Var -> Doc
    text Var
    "$map"
        prettyP Int
    p (BMap Var
    c)      = Var -> Doc
    text (Var
    "$map_" Var -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Var
    c)
        prettyP Int
    p Builtin
    BId           = Var -> Doc
    text Var
    "$id"
        prettyP Int
    p (BProj Int
    2 Int
    1)   = Var -> Doc
    text Var
    "$fst"
        prettyP Int
    p (BProj Int
    2 Int
    2)   = Var -> Doc
    text Var
    "$snd"
        prettyP Int
    p (BProj Int
    3 Int
    1)   = Var -> Doc
    text Var
    "$fst3"
        prettyP Int
    p (BProj Int
    3 Int
    2)   = Var -> Doc
    text Var
    "$snd3"
        prettyP Int
    p (BProj Int
    3 Int
    3)   = Var -> Doc
    text Var
    "$thd3"
        prettyP Int
    p (BProj Int
    l Int
    i)   = Var -> Doc
    text (Var
    "$proj_" Var -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> Var
    forall a. Show a => a -> Var
    show Int
    l Var -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Var
    "_" Var -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> Var
    forall a. Show a => a -> Var
    show Int
    i)
        prettyP Int
    p (BMapTuple Int
    2) = Var -> Doc
    text Var
    "$map_Pair"
        prettyP Int
    p (BMapTuple Int
    3) = Var -> Doc
    text Var
    "$map_Triple"
        prettyP Int
    p (BMapTuple Int
    n) = Var -> Doc
    text (Var -> Doc) -> Var -> Doc
    forall a b. (a -> b) -> a -> b
    $ Var
    "$map_Tuple" Var -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> Var
    forall a. Show a => a -> Var
    show Int
    n
        prettyP Int
    p Builtin
    BArr          = Var -> Doc
    text Var
    "$arr"

    -- vim: ts=4:sts=4:expandtab:ai