{-# 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"