{-# 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
/= :: 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 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