{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Debug.SimpleReflect.Expr
-- Copyright   :  (c) 2008-2014 Twan van Laarhoven
-- License     :  BSD-style
--
-- Maintainer  :  twanvl@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Simple reflection of haskell expressions containing variables.
--
-----------------------------------------------------------------------------
module Debug.SimpleReflect.Expr
    ( -- * Construction
      Expr
    , FromExpr(..)
    , var, fun, Associativity(..), op
      -- * Evaluating
    , expr, reduce, reduction
    ) where

import Data.List
import Data.Monoid
#if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Control.Applicative

------------------------------------------------------------------------------
-- Data type
------------------------------------------------------------------------------

-- | A reflected expression
data Expr = Expr
   { Expr -> Int -> ShowS
showExpr   :: Int -> ShowS  -- ^ Show with the given precedence level
   , Expr -> Maybe Integer
intExpr    :: Maybe Integer -- ^ Integer value?
   , Expr -> Maybe Double
doubleExpr :: Maybe Double  -- ^ Floating value?
   , Expr -> Maybe Expr
reduced    :: Maybe Expr    -- ^ Next reduction step
   }

instance Show Expr where
    showsPrec :: Int -> Expr -> ShowS
showsPrec Int
p Expr
r = Expr -> Int -> ShowS
showExpr Expr
r Int
p

-- | Default expression
emptyExpr :: Expr
emptyExpr :: Expr
emptyExpr = Expr :: (Int -> ShowS)
-> Maybe Integer -> Maybe Double -> Maybe Expr -> Expr
Expr { showExpr :: Int -> ShowS
showExpr   = \Int
_ -> String -> ShowS
showString String
""
                 , intExpr :: Maybe Integer
intExpr    = Maybe Integer
forall a. Maybe a
Nothing
                 , doubleExpr :: Maybe Double
doubleExpr = Maybe Double
forall a. Maybe a
Nothing
                 , reduced :: Maybe Expr
reduced    = Maybe Expr
forall a. Maybe a
Nothing
                 }

------------------------------------------------------------------------------
-- Lifting and combining expressions
------------------------------------------------------------------------------

-- | A variable with the given name
var :: String -> Expr
var :: String -> Expr
var String
s = Expr
emptyExpr { showExpr :: Int -> ShowS
showExpr = \Int
_ -> String -> ShowS
showString String
s }

lift :: Show a => a -> Expr
lift :: forall a. Show a => a -> Expr
lift a
x = Expr
emptyExpr { showExpr :: Int -> ShowS
showExpr = \Int
p -> Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p a
x }

-- | This data type specifies the associativity of operators: left, right or none.
data Associativity = InfixL | Infix | InfixR deriving Associativity -> Associativity -> Bool
(Associativity -> Associativity -> Bool)
-> (Associativity -> Associativity -> Bool) -> Eq Associativity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Associativity -> Associativity -> Bool
$c/= :: Associativity -> Associativity -> Bool
== :: Associativity -> Associativity -> Bool
$c== :: Associativity -> Associativity -> Bool
Eq

-- | An infix operator with the given associativity, precedence and name
op :: Associativity -> Int -> String -> Expr -> Expr -> Expr
op :: Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
fix Int
prec String
opName Expr
a Expr
b = Expr
emptyExpr { showExpr :: Int -> ShowS
showExpr = Int -> ShowS
showFun }
 where showFun :: Int -> ShowS
showFun Int
p = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
prec)
                     (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Expr -> Int -> ShowS
showExpr Expr
a (if Associativity
fix Associativity -> Associativity -> Bool
forall a. Eq a => a -> a -> Bool
== Associativity
InfixL then Int
prec else Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
opName
                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Int -> ShowS
showExpr Expr
b (if Associativity
fix Associativity -> Associativity -> Bool
forall a. Eq a => a -> a -> Bool
== Associativity
InfixR then Int
prec else Int
prec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

------------------------------------------------------------------------------
-- Adding numeric results
------------------------------------------------------------------------------

iOp :: (Expr -> Expr) -> (Integer -> Integer) -> Expr -> Expr
iOp2 :: (Expr -> Expr -> Expr) -> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
dOp :: (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
dOp2 :: (Expr -> Expr -> Expr) -> (Double -> Double -> Double) -> Expr -> Expr -> Expr

iOp :: (Expr -> Expr) -> (Integer -> Integer) -> Expr -> Expr
iOp  Expr -> Expr
r Integer -> Integer
f Expr
a   = (Expr -> Expr
r Expr
a  ) { intExpr :: Maybe Integer
intExpr    = Integer -> Integer
f (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Integer
intExpr    Expr
a }
iOp2 :: (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
iOp2 Expr -> Expr -> Expr
r Integer -> Integer -> Integer
f Expr
a Expr
b = (Expr -> Expr -> Expr
r Expr
a Expr
b) { intExpr :: Maybe Integer
intExpr    = Integer -> Integer -> Integer
f (Integer -> Integer -> Integer)
-> Maybe Integer -> Maybe (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Integer
intExpr    Expr
a Maybe (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> Maybe Integer
intExpr    Expr
b }
dOp :: (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
dOp  Expr -> Expr
r Double -> Double
f Expr
a   = (Expr -> Expr
r Expr
a  ) { doubleExpr :: Maybe Double
doubleExpr = Double -> Double
f (Double -> Double) -> Maybe Double -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Double
doubleExpr Expr
a }
dOp2 :: (Expr -> Expr -> Expr)
-> (Double -> Double -> Double) -> Expr -> Expr -> Expr
dOp2 Expr -> Expr -> Expr
r Double -> Double -> Double
f Expr
a Expr
b = (Expr -> Expr -> Expr
r Expr
a Expr
b) { doubleExpr :: Maybe Double
doubleExpr = Double -> Double -> Double
f (Double -> Double -> Double)
-> Maybe Double -> Maybe (Double -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Double
doubleExpr Expr
a Maybe (Double -> Double) -> Maybe Double -> Maybe Double
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> Maybe Double
doubleExpr Expr
b }

withReduce :: (Expr -> Expr) -> (Expr -> Expr)
withReduce :: (Expr -> Expr) -> Expr -> Expr
withReduce Expr -> Expr
r Expr
a    = let rr :: Expr
rr = Expr -> Expr
r Expr
a in
                    Expr
rr { reduced :: Maybe Expr
reduced = (Expr -> Expr) -> Expr -> Expr
withReduce Expr -> Expr
r (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Expr
reduced Expr
a
                               Maybe Expr -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Expr
forall a. Num a => Integer -> a
fromInteger (Integer -> Expr) -> Maybe Integer -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Integer
intExpr    Expr
rr
                               Maybe Expr -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> Expr
fromDouble  (Double -> Expr) -> Maybe Double -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Double
doubleExpr Expr
rr
                       }
withReduce2 :: (Expr -> Expr -> Expr) -> (Expr -> Expr -> Expr)
withReduce2 :: (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 Expr -> Expr -> Expr
r Expr
a Expr
b = let rr :: Expr
rr = Expr -> Expr -> Expr
r Expr
a Expr
b in
                    Expr
rr { reduced :: Maybe Expr
reduced = (\Expr
a' -> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 Expr -> Expr -> Expr
r Expr
a' Expr
b) (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Expr
reduced Expr
a
                               Maybe Expr -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Expr
b' -> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 Expr -> Expr -> Expr
r Expr
a Expr
b') (Expr -> Expr) -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Expr
reduced Expr
b
                               Maybe Expr -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Expr
forall a. Num a => Integer -> a
fromInteger (Integer -> Expr) -> Maybe Integer -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Integer
intExpr    Expr
rr
                               Maybe Expr -> Maybe Expr -> Maybe Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> Expr
fromDouble  (Double -> Expr) -> Maybe Double -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> Maybe Double
doubleExpr Expr
rr
                       }

------------------------------------------------------------------------------
-- Function types
------------------------------------------------------------------------------

-- | Conversion from @Expr@ to other types
class FromExpr a where
    fromExpr :: Expr -> a

instance FromExpr Expr where
    fromExpr :: Expr -> Expr
fromExpr = Expr -> Expr
forall a. a -> a
id

instance (Show a, FromExpr b) => FromExpr (a -> b) where
    fromExpr :: Expr -> a -> b
fromExpr Expr
f a
a = Expr -> b
forall a. FromExpr a => Expr -> a
fromExpr (Expr -> b) -> Expr -> b
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixL Int
10 String
" " Expr
f (a -> Expr
forall a. Show a => a -> Expr
lift a
a)

-- | A generic, overloaded, function variable
fun :: FromExpr a => String -> a
fun :: forall a. FromExpr a => String -> a
fun = Expr -> a
forall a. FromExpr a => Expr -> a
fromExpr (Expr -> a) -> (String -> Expr) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Expr
var

------------------------------------------------------------------------------
-- Forcing conversion & evaluation
------------------------------------------------------------------------------

-- | Force something to be an expression.
expr :: Expr -> Expr
expr :: Expr -> Expr
expr = Expr -> Expr
forall a. a -> a
id

-- | Reduce (evaluate) an expression once.
--
--   For example @reduce (1 + 2 + 3 + 4)  ==  3 + 3 + 4@
reduce :: Expr -> Expr
reduce :: Expr -> Expr
reduce Expr
e = Expr -> (Expr -> Expr) -> Maybe Expr -> Expr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expr
e Expr -> Expr
forall a. a -> a
id (Expr -> Maybe Expr
reduced Expr
e)

-- | Show all reduction steps when evaluating an expression.
reduction :: Expr -> [Expr]
reduction :: Expr -> [Expr]
reduction Expr
e0 = Expr
e0 Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: (Expr -> Maybe (Expr, Expr)) -> Expr -> [Expr]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\Expr
e -> do Expr
e' <- Expr -> Maybe Expr
reduced Expr
e; (Expr, Expr) -> Maybe (Expr, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr
e',Expr
e')) Expr
e0

------------------------------------------------------------------------------
-- Numeric classes
------------------------------------------------------------------------------

instance Eq Expr where
    Expr{ intExpr :: Expr -> Maybe Integer
intExpr    = Just Integer
a } == :: Expr -> Expr -> Bool
== Expr{ intExpr :: Expr -> Maybe Integer
intExpr    = Just Integer
b }  =  Integer
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
b
    Expr{ doubleExpr :: Expr -> Maybe Double
doubleExpr = Just Double
a } == Expr{ doubleExpr :: Expr -> Maybe Double
doubleExpr = Just Double
b }  =  Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
b
    Expr
a                           == Expr
b                            =  Expr -> String
forall a. Show a => a -> String
show Expr
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Expr -> String
forall a. Show a => a -> String
show Expr
b

instance Ord Expr where
    compare :: Expr -> Expr -> Ordering
compare Expr{ intExpr :: Expr -> Maybe Integer
intExpr    = Just Integer
a } Expr{ intExpr :: Expr -> Maybe Integer
intExpr    = Just Integer
b }  =  Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
a Integer
b
    compare Expr{ doubleExpr :: Expr -> Maybe Double
doubleExpr = Just Double
a } Expr{ doubleExpr :: Expr -> Maybe Double
doubleExpr = Just Double
b }  =  Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
a Double
b
    compare Expr
a                           Expr
b                            =  String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Expr -> String
forall a. Show a => a -> String
show Expr
a) (Expr -> String
forall a. Show a => a -> String
show Expr
b)
    min :: Expr -> Expr -> Expr
min = String -> Expr -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"min" (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
`iOp2` Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Expr -> Expr -> Expr)
-> (Double -> Double -> Double) -> Expr -> Expr -> Expr
`dOp2` Double -> Double -> Double
forall a. Ord a => a -> a -> a
min
    max :: Expr -> Expr -> Expr
max = String -> Expr -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"max" (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
`iOp2` Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max (Expr -> Expr -> Expr)
-> (Double -> Double -> Double) -> Expr -> Expr -> Expr
`dOp2` Double -> Double -> Double
forall a. Ord a => a -> a -> a
max

instance Num Expr where
    + :: Expr -> Expr -> Expr
(+)    = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixL Int
6 String
" + " (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
`iOp2` Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)   (Expr -> Expr -> Expr)
-> (Double -> Double -> Double) -> Expr -> Expr -> Expr
`dOp2` Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
    (-)    = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixL Int
6 String
" - " (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
`iOp2` (-)   (Expr -> Expr -> Expr)
-> (Double -> Double -> Double) -> Expr -> Expr -> Expr
`dOp2` (-)
    * :: Expr -> Expr -> Expr
(*)    = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixL Int
7 String
" * " (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
`iOp2` Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*)   (Expr -> Expr -> Expr)
-> (Double -> Double -> Double) -> Expr -> Expr -> Expr
`dOp2` Double -> Double -> Double
forall a. Num a => a -> a -> a
(*)
    negate :: Expr -> Expr
negate = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"negate" (Expr -> Expr) -> (Integer -> Integer) -> Expr -> Expr
`iOp` Integer -> Integer
forall a. Num a => a -> a
negate (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Num a => a -> a
negate
    abs :: Expr -> Expr
abs    = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"abs"    (Expr -> Expr) -> (Integer -> Integer) -> Expr -> Expr
`iOp` Integer -> Integer
forall a. Num a => a -> a
abs    (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Num a => a -> a
abs
    signum :: Expr -> Expr
signum = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"signum" (Expr -> Expr) -> (Integer -> Integer) -> Expr -> Expr
`iOp` Integer -> Integer
forall a. Num a => a -> a
signum (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Num a => a -> a
signum
    fromInteger :: Integer -> Expr
fromInteger Integer
i = (Integer -> Expr
forall a. Show a => a -> Expr
lift Integer
i)
                     { intExpr :: Maybe Integer
intExpr    = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
                     , doubleExpr :: Maybe Double
doubleExpr = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i }

instance Real Expr where
    toRational :: Expr -> Rational
toRational Expr
someExpr = case (Expr -> Maybe Double
doubleExpr Expr
someExpr, Expr -> Maybe Integer
intExpr Expr
someExpr) of
          (Just Double
d,Maybe Integer
_) -> Double -> Rational
forall a. Real a => a -> Rational
toRational Double
d
          (Maybe Double
_,Just Integer
i) -> Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
i
          (Maybe Double, Maybe Integer)
_          -> String -> Rational
forall a. HasCallStack => String -> a
error (String -> Rational) -> String -> Rational
forall a b. (a -> b) -> a -> b
$ String
"not a rational number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
someExpr

instance Integral Expr where
    quotRem :: Expr -> Expr -> (Expr, Expr)
quotRem Expr
a Expr
b = (Expr -> Expr -> Expr
forall a. Integral a => a -> a -> a
quot Expr
a Expr
b, Expr -> Expr -> Expr
forall a. Integral a => a -> a -> a
rem Expr
a Expr
b)
    divMod :: Expr -> Expr -> (Expr, Expr)
divMod  Expr
a Expr
b = (Expr -> Expr -> Expr
forall a. Integral a => a -> a -> a
div  Expr
a Expr
b, Expr -> Expr -> Expr
forall a. Integral a => a -> a -> a
mod Expr
a Expr
b)
    quot :: Expr -> Expr -> Expr
quot = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixL Int
7 String
" `quot` " (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
`iOp2` Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot
    rem :: Expr -> Expr -> Expr
rem  = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixL Int
7 String
" `rem` "  (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
`iOp2` Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
rem
    div :: Expr -> Expr -> Expr
div  = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixL Int
7 String
" `div` "  (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
`iOp2` Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div
    mod :: Expr -> Expr -> Expr
mod  = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixL Int
7 String
" `mod` "  (Expr -> Expr -> Expr)
-> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr
`iOp2` Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod
    toInteger :: Expr -> Integer
toInteger Expr
someExpr = case Expr -> Maybe Integer
intExpr Expr
someExpr of
          Just Integer
i -> Integer
i
          Maybe Integer
_      -> String -> Integer
forall a. HasCallStack => String -> a
error (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ String
"not an integer: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr -> String
forall a. Show a => a -> String
show Expr
someExpr

instance Fractional Expr where
    / :: Expr -> Expr -> Expr
(/)   = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixL Int
7 String
" / " (Expr -> Expr -> Expr)
-> (Double -> Double -> Double) -> Expr -> Expr -> Expr
`dOp2` Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/)
    recip :: Expr -> Expr
recip = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"recip"  (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Fractional a => a -> a
recip
    fromRational :: Rational -> Expr
fromRational Rational
r = Double -> Expr
fromDouble (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)

fromDouble :: Double -> Expr
fromDouble :: Double -> Expr
fromDouble Double
d = (Double -> Expr
forall a. Show a => a -> Expr
lift Double
d) { doubleExpr :: Maybe Double
doubleExpr = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
d }

instance Floating Expr where
    pi :: Expr
pi    = (String -> Expr
var String
"pi") { doubleExpr :: Maybe Double
doubleExpr = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
forall a. Floating a => a
pi }
    exp :: Expr -> Expr
exp   = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"exp"   (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
exp
    sqrt :: Expr -> Expr
sqrt  = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"sqrt"  (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
sqrt
    log :: Expr -> Expr
log   = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"log"   (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
log
    ** :: Expr -> Expr -> Expr
(**)  = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixR Int
8 String
"**" (Expr -> Expr -> Expr)
-> (Double -> Double -> Double) -> Expr -> Expr -> Expr
`dOp2` Double -> Double -> Double
forall a. Floating a => a -> a -> a
(**)
    sin :: Expr -> Expr
sin   = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"sin"   (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
sin
    cos :: Expr -> Expr
cos   = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"cos"   (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
cos
    sinh :: Expr -> Expr
sinh  = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"sinh"  (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
sinh
    cosh :: Expr -> Expr
cosh  = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"cosh"  (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
cosh
    asin :: Expr -> Expr
asin  = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"asin"  (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
asin
    acos :: Expr -> Expr
acos  = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"acos"  (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
acos
    atan :: Expr -> Expr
atan  = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"atan"  (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
atan
    asinh :: Expr -> Expr
asinh = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"asinh" (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
asinh
    acosh :: Expr -> Expr
acosh = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"acosh" (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
acosh
    atanh :: Expr -> Expr
atanh = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"atanh" (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Floating a => a -> a
atanh

instance Enum Expr where
    succ :: Expr -> Expr
succ   = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"succ" (Expr -> Expr) -> (Integer -> Integer) -> Expr -> Expr
`iOp` Integer -> Integer
forall a. Enum a => a -> a
succ (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Enum a => a -> a
succ
    pred :: Expr -> Expr
pred   = (Expr -> Expr) -> Expr -> Expr
withReduce  ((Expr -> Expr) -> Expr -> Expr) -> (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr
forall a. FromExpr a => String -> a
fun String
"pred" (Expr -> Expr) -> (Integer -> Integer) -> Expr -> Expr
`iOp` Integer -> Integer
forall a. Enum a => a -> a
pred (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr
`dOp` Double -> Double
forall a. Enum a => a -> a
pred
    toEnum :: Int -> Expr
toEnum = String -> Int -> Expr
forall a. FromExpr a => String -> a
fun String
"toEnum"
    fromEnum :: Expr -> Int
fromEnum = Integer -> Int
forall a. Enum a => a -> Int
fromEnum (Integer -> Int) -> (Expr -> Integer) -> Expr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Integer
forall a. Integral a => a -> Integer
toInteger
    enumFrom :: Expr -> [Expr]
enumFrom       Expr
a     = (Integer -> Expr) -> [Integer] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Expr
forall a. Num a => Integer -> a
fromInteger ([Integer] -> [Expr]) -> [Integer] -> [Expr]
forall a b. (a -> b) -> a -> b
$ Integer -> [Integer]
forall a. Enum a => a -> [a]
enumFrom       (Expr -> Integer
forall a. Integral a => a -> Integer
toInteger Expr
a)
    enumFromThen :: Expr -> Expr -> [Expr]
enumFromThen   Expr
a Expr
b   = (Integer -> Expr) -> [Integer] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Expr
forall a. Num a => Integer -> a
fromInteger ([Integer] -> [Expr]) -> [Integer] -> [Expr]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromThen   (Expr -> Integer
forall a. Integral a => a -> Integer
toInteger Expr
a) (Expr -> Integer
forall a. Integral a => a -> Integer
toInteger Expr
b)
    enumFromTo :: Expr -> Expr -> [Expr]
enumFromTo     Expr
a   Expr
c = (Integer -> Expr) -> [Integer] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Expr
forall a. Num a => Integer -> a
fromInteger ([Integer] -> [Expr]) -> [Integer] -> [Expr]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromTo     (Expr -> Integer
forall a. Integral a => a -> Integer
toInteger Expr
a)               (Expr -> Integer
forall a. Integral a => a -> Integer
toInteger Expr
c)
    enumFromThenTo :: Expr -> Expr -> Expr -> [Expr]
enumFromThenTo Expr
a Expr
b Expr
c = (Integer -> Expr) -> [Integer] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Expr
forall a. Num a => Integer -> a
fromInteger ([Integer] -> [Expr]) -> [Integer] -> [Expr]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo (Expr -> Integer
forall a. Integral a => a -> Integer
toInteger Expr
a) (Expr -> Integer
forall a. Integral a => a -> Integer
toInteger Expr
b) (Expr -> Integer
forall a. Integral a => a -> Integer
toInteger Expr
c)

instance Bounded Expr where
    minBound :: Expr
minBound = String -> Expr
var String
"minBound"
    maxBound :: Expr
maxBound = String -> Expr
var String
"maxBound"

------------------------------------------------------------------------------
-- Other classes
------------------------------------------------------------------------------

#if MIN_VERSION_base(4,9,0)
instance Semigroup Expr where
    <> :: Expr -> Expr -> Expr
(<>) = (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
withReduce2 ((Expr -> Expr -> Expr) -> Expr -> Expr -> Expr)
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Associativity -> Int -> String -> Expr -> Expr -> Expr
op Associativity
InfixR Int
6 String
" <> "
#endif

instance Monoid Expr where
    mempty :: Expr
mempty = String -> Expr
var String
"mempty"
#if !(MIN_VERSION_base(4,11,0))
    mappend = withReduce2 $ op InfixR 6 " <> "
#endif
    mconcat :: [Expr] -> Expr
mconcat = String -> [Expr] -> Expr
forall a. FromExpr a => String -> a
fun String
"mconcat"