{-# 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 v :: Var
v (EBuiltin _)
    = Bool
False
varInExpr v :: Var
v (EVar v' :: Var
v')
    = Var
v Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
v'
varInExpr v :: Var
v (EVarOp _ _ v' :: Var
v')
    = Bool
False
varInExpr v :: Var
v (EApp e1 :: Expr
e1 e2 :: Expr
e2)
    = Var -> Expr -> Bool
varInExpr Var
v Expr
e1 Bool -> Bool -> Bool
|| Var -> Expr -> Bool
varInExpr Var
v Expr
e2
varInExpr v :: Var
v (ETyApp e1 :: Expr
e1 t :: Type
t)
    = Var -> Expr -> Bool
varInExpr Var
v Expr
e1

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

exprSubst :: Var -> Expr -> Expr -> Expr
exprSubst :: Var -> Expr -> Expr -> Expr
exprSubst v :: Var
v e :: Expr
e e' :: Expr
e'@(EBuiltin _)
    = Expr
e'
exprSubst v :: Var
v e :: Expr
e e' :: Expr
e'@(EVar v' :: Var
v')
    | Var
v Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
v'   = Expr
e
    | Bool
otherwise = Expr
e'
exprSubst v :: Var
v e :: Expr
e e' :: Expr
e'@(EVarOp _ _ v' :: Var
v')
    | Var
v Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
v'   = Expr
e
    | Bool
otherwise = Expr
e'
exprSubst v :: Var
v e :: Expr
e (EApp e1 :: Expr
e1 e2 :: 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 v :: Var
v e :: Expr
e (ETyApp e1 :: Expr
e1 t :: 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
/= :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c== :: 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
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> Var
$cshow :: Fixity -> Var
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> 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
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: 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
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> Var
$cshow :: Expr -> Var
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> 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
/= :: Builtin -> Builtin -> Bool
$c/= :: Builtin -> Builtin -> Bool
== :: Builtin -> Builtin -> Bool
$c== :: 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
showList :: [Builtin] -> ShowS
$cshowList :: [Builtin] -> ShowS
show :: Builtin -> Var
$cshow :: Builtin -> Var
showsPrec :: Int -> Builtin -> ShowS
$cshowsPrec :: Int -> 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
/= :: ExprCtx -> ExprCtx -> Bool
$c/= :: ExprCtx -> ExprCtx -> Bool
== :: ExprCtx -> ExprCtx -> Bool
$c== :: 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
showList :: [ExprCtx] -> ShowS
$cshowList :: [ExprCtx] -> ShowS
show :: ExprCtx -> Var
$cshow :: ExprCtx -> Var
showsPrec :: Int -> ExprCtx -> ShowS
$cshowsPrec :: Int -> ExprCtx -> ShowS
Show)

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

unzipExpr :: Expr -> ExprCtx -> Expr
unzipExpr :: Expr -> ExprCtx -> Expr
unzipExpr e :: Expr
e ECDot = Expr
e
unzipExpr e :: Expr
e (ECAppL c :: ExprCtx
c e2 :: Expr
e2) = Expr -> ExprCtx -> Expr
unzipExpr (Expr -> Expr -> Expr
EApp Expr
e Expr
e2) ExprCtx
c
unzipExpr e :: Expr
e (ECAppR e1 :: Expr
e1 c :: ExprCtx
c) = Expr -> ExprCtx -> Expr
unzipExpr (Expr -> Expr -> Expr
EApp Expr
e1 Expr
e) ExprCtx
c
unzipExpr e :: Expr
e (ECTyApp c :: ExprCtx
c t :: 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 v :: Var
v ECDot
    = Bool
False
varInCtx v :: Var
v (ECAppL c :: ExprCtx
c e2 :: Expr
e2)
    = Var -> ExprCtx -> Bool
varInCtx Var
v ExprCtx
c Bool -> Bool -> Bool
|| Var -> Expr -> Bool
varInExpr Var
v Expr
e2
varInCtx v :: Var
v (ECAppR e1 :: Expr
e1 c :: ExprCtx
c)
    = Var -> ExprCtx -> Bool
varInCtx Var
v ExprCtx
c Bool -> Bool -> Bool
|| Var -> Expr -> Bool
varInExpr Var
v Expr
e1
varInCtx v :: Var
v (ECTyApp c :: ExprCtx
c _)
    = Var -> ExprCtx -> Bool
varInCtx Var
v ExprCtx
c

precAPP :: Int
precAPP :: Int
precAPP = 10

instance Pretty Expr where
    prettyP :: Int -> Expr -> Doc
prettyP p :: Int
p (EBuiltin b :: Builtin
b)
        = Int -> Builtin -> Doc
forall a. Pretty a => Int -> a -> Doc
prettyP Int
p Builtin
b
    prettyP _ (EVar v :: Var
v)
        = Var -> Doc
text Var
v
    prettyP _ (EVarOp _ _ v :: Var
v)
        = Doc
lparen Doc -> Doc -> Doc
<> Var -> Doc
text Var
v Doc -> Doc -> Doc
<> Doc
rparen
    prettyP p :: Int
p (EApp (EApp (EVarOp fix :: Fixity
fix prec :: Int
prec op :: Var
op) e1 :: Expr
e1) e2 :: 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
+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
+1
    prettyP p :: Int
p (EApp e1 :: Expr
e1 e2 :: 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
+1) Expr
e2
        )
    prettyP p :: Int
p (ETyApp e :: Expr
e t :: 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 p :: Int
p (BMap "[]")   = Var -> Doc
text "$map"
    prettyP p :: Int
p (BMap c :: Var
c)      = Var -> Doc
text ("$map_" Var -> ShowS
forall a. [a] -> [a] -> [a]
++ Var
c)
    prettyP p :: Int
p BId           = Var -> Doc
text "$id"
    prettyP p :: Int
p (BProj 2 1)   = Var -> Doc
text "$fst"
    prettyP p :: Int
p (BProj 2 2)   = Var -> Doc
text "$snd"
    prettyP p :: Int
p (BProj 3 1)   = Var -> Doc
text "$fst3"
    prettyP p :: Int
p (BProj 3 2)   = Var -> Doc
text "$snd3"
    prettyP p :: Int
p (BProj 3 3)   = Var -> Doc
text "$thd3"
    prettyP p :: Int
p (BProj l :: Int
l i :: Int
i)   = Var -> Doc
text ("$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 -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Var
forall a. Show a => a -> Var
show Int
i)
    prettyP p :: Int
p (BMapTuple 2) = Var -> Doc
text "$map_Pair"
    prettyP p :: Int
p (BMapTuple 3) = Var -> Doc
text "$map_Triple"
    prettyP p :: Int
p (BMapTuple n :: Int
n) = Var -> Doc
text (Var -> Doc) -> Var -> Doc
forall a b. (a -> b) -> a -> b
$ "$map_Tuple" Var -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Var
forall a. Show a => a -> Var
show Int
n
    prettyP p :: Int
p BArr          = Var -> Doc
text "$arr"

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