-- |
-- Module      : Data.Express.Core
-- Copyright   : (c) 2019-2021 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module defines the 'Expr' type and basic utilities involving it.
--
-- This is the core of the Express library.
-- As a user, you are probably better of importing "Data.Express".
-- If you want to understand how the library works,
-- this is the place to start.
--
-- The complexity of most functions are given in big O notation
-- where /n/ is the size of the expression being manipulated or produced.
-- There may still be a /m/ cost associated with the values being stored in 'Expr's.
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ == 708
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
module Data.Express.Core
  (
  -- * The Expr datatype
    Expr (..)

  -- * Smart constructors
  , value
  , val
  , ($$)
  , var

  -- * Evaluating Exprs
  , evaluate
  , eval
  , evl
  , typ
  , etyp
  , mtyp
  , toDynamic

  -- * Boolean properties
  , isValue
  , isApp
  , isVar
  , isConst
  , isIllTyped
  , isWellTyped
  , isFun
  , hasVar
  , isGround

  -- * Comparison
  , compareComplexity
  , compareLexicographically
  , compareQuickly

  -- * Properties
  , arity
  , size
  , depth
  , height

  -- * Listing subexpressions
  , subexprs
  , values
  , vars
  , consts
  , nubSubexprs
  , nubValues
  , nubVars
  , nubConsts

  -- * Other utilities
  , unfoldApp
  , showExpr
  , showOpExpr
  , showPrecExpr
  )
where

import Data.Dynamic
import Data.Express.Utils
import Data.Express.Utils.Typeable

-- |
-- Values of type 'Expr' represent objects or applications between objects.
-- Each object is encapsulated together with its type and string representation.
-- Values encoded in 'Expr's are always monomorphic.
--
-- An 'Expr' can be constructed using:
--
-- * 'val',   for values that are 'Show' instances;
-- * 'value', for values that are not 'Show' instances, like functions;
-- * ':$',    for applications between 'Expr's.
--
-- > > val False
-- > False :: Bool
--
-- > > value "not" not :$ val False
-- > not False :: Bool
--
-- An 'Expr' can be evaluated using 'evaluate', 'eval' or 'evl'.
--
-- > > evl $ val (1 :: Int) :: Int
-- > 1
--
-- > > evaluate $ val (1 :: Int) :: Maybe Bool
-- > Nothing
--
-- > > eval 'a' (val 'b')
-- > 'b'
--
-- 'Show'ing a value of type 'Expr' will return a pretty-printed representation
-- of the expression together with its type.
--
-- > > show (value "not" not :$ val False)
-- > "not False :: Bool"
--
-- 'Expr' is like 'Dynamic' but has support for applications and variables
-- (':$', 'var').
--
-- /The 'var' underscore convention:/
-- Functions that manipulate 'Expr's usually follow the convention
-- where a 'value' whose 'String' representation starts with @'_'@
-- represents a 'var'iable.
data Expr  =  Value String Dynamic -- ^ a 'value' enconded as 'String' and 'Dynamic'
           |  Expr :$ Expr         -- ^ function application between expressions

#if __GLASGOW_HASKELL__ == 708
deriving instance Typeable Expr
#endif

-- | /O(1)/.
-- It takes a string representation of a value and a value, returning an
-- 'Expr' with that terminal value.
-- For instances of 'Show', it is preferable to use 'val'.
--
-- > > value "0" (0 :: Integer)
-- > 0 :: Integer
--
-- > > value "'a'" 'a'
-- > 'a' :: Char
--
-- > > value "True" True
-- > True :: Bool
--
-- > > value "id" (id :: Int -> Int)
-- > id :: Int -> Int
--
-- > > value "(+)" ((+) :: Int -> Int -> Int)
-- > (+) :: Int -> Int -> Int
--
-- > > value "sort" (sort :: [Bool] -> [Bool])
-- > sort :: [Bool] -> [Bool]
value :: Typeable a => String -> a -> Expr
value :: forall a. Typeable a => String -> a -> Expr
value String
s a
x = String -> Dynamic -> Expr
Value String
s (forall a. Typeable a => a -> Dynamic
toDyn a
x)

-- | /O(1)/.
-- A shorthand for 'value' for values that are 'Show' instances.
--
-- > > val (0 :: Int)
-- > 0 :: Int
--
-- > > val 'a'
-- > 'a' :: Char
--
-- > > val True
-- > True :: Bool
--
-- Example equivalences to 'value':
--
-- > val 0     =  value "0" 0
-- > val 'a'   =  value "'a'" 'a'
-- > val True  =  value "True" True
val :: (Typeable a, Show a) => a -> Expr
val :: forall a. (Typeable a, Show a) => a -> Expr
val a
x = forall a. Typeable a => String -> a -> Expr
value (forall a. Show a => a -> String
show a
x) a
x

-- | /O(n)/.
-- Creates an 'Expr' representing a function application.
-- 'Just' an 'Expr' application if the types match, 'Nothing' otherwise.
-- (cf. ':$')
--
-- > > value "id" (id :: () -> ()) $$ val ()
-- > Just (id () :: ())
--
-- > > value "abs" (abs :: Int -> Int) $$ val (1337 :: Int)
-- > Just (abs 1337 :: Int)
--
-- > > value "abs" (abs :: Int -> Int) $$ val 'a'
-- > Nothing
--
-- > > value "abs" (abs :: Int -> Int) $$ val ()
-- > Nothing
($$) :: Expr -> Expr -> Maybe Expr
Expr
e1 $$ :: Expr -> Expr -> Maybe Expr
$$ Expr
e2 | Expr -> Bool
isIllTyped Expr
e  =  forall a. Maybe a
Nothing
         | Bool
otherwise     =  forall a. a -> Maybe a
Just Expr
e
  where
  e :: Expr
e = Expr
e1 Expr -> Expr -> Expr
:$ Expr
e2

-- | /O(1)/.
-- Creates an 'Expr' representing a variable with the given name and argument
-- type.
--
-- > > var "x" (undefined :: Int)
-- > x :: Int
--
-- > > var "u" (undefined :: ())
-- > u :: ()
--
-- > > var "xs" (undefined :: [Int])
-- > xs :: [Int]
--
-- This function follows the /underscore convention/:
-- a variable is just a 'value' whose string representation
-- starts with underscore (@'_'@).
var :: Typeable a => String -> a -> Expr
var :: forall a. Typeable a => String -> a -> Expr
var String
s a
a = forall a. Typeable a => String -> a -> Expr
value (Char
'_'forall a. a -> [a] -> [a]
:String
s) (forall a. HasCallStack => a
undefined forall a. a -> a -> a
`asTypeOf` a
a)

-- | /O(n)/.
-- Computes the type of an expression.  This raises errors, but this should
-- not happen if expressions are smart-constructed with '$$'.
--
-- > > let one = val (1 :: Int)
-- > > let bee = val 'b'
-- > > let absE = value "abs" (abs :: Int -> Int)
--
-- > > typ one
-- > Int
--
-- > > typ bee
-- > Char
--
-- > > typ absE
-- > Int -> Int
--
-- > > typ (absE :$ one)
-- > Int
--
-- > > typ (absE :$ bee)
-- > *** Exception: type mismatch, cannot apply `Int -> Int' to `Char'
--
-- > > typ ((absE :$ bee) :$ one)
-- > *** Exception: type mismatch, cannot apply `Int -> Int' to `Char'
typ :: Expr -> TypeRep
typ :: Expr -> TypeRep
typ  =  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a} {a} {a}. (Show a, Show a) => (a, a) -> a
err forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Either (TypeRep, TypeRep) TypeRep
etyp
  where
  err :: (a, a) -> a
err (a
t1, a
t2)  =  forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"type mismatch, cannot apply `"
                forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
t1 forall a. [a] -> [a] -> [a]
++ String
"' to `" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
t2 forall a. [a] -> [a] -> [a]
++ String
"'"

-- | /O(n)/.
-- Computes the type of an expression returning either the type of the given
-- expression when possible or when there is a type error, the pair of types
-- which produced the error.
--
-- > > let one = val (1 :: Int)
-- > > let bee = val 'b'
-- > > let absE = value "abs" (abs :: Int -> Int)
--
-- > > etyp one
-- > Right Int
--
-- > > etyp bee
-- > Right Char
--
-- > > etyp absE
-- > Right (Int -> Int)
--
-- > > etyp (absE :$ one)
-- > Right Int
--
-- > > etyp (absE :$ bee)
-- > Left (Int -> Int, Char)
--
-- > > etyp ((absE :$ bee) :$ one)
-- > Left (Int -> Int, Char)
etyp :: Expr -> Either (TypeRep, TypeRep) TypeRep
etyp :: Expr -> Either (TypeRep, TypeRep) TypeRep
etyp (Value String
_ Dynamic
d) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Dynamic -> TypeRep
dynTypeRep Dynamic
d
etyp (Expr
e1 :$ Expr
e2) = case (Expr -> Either (TypeRep, TypeRep) TypeRep
etyp Expr
e1, Expr -> Either (TypeRep, TypeRep) TypeRep
etyp Expr
e2) of
  (Right TypeRep
t1, Right TypeRep
t2) -> case TypeRep
t1 TypeRep -> TypeRep -> Maybe TypeRep
`funResultTy` TypeRep
t2 of
                          Maybe TypeRep
Nothing -> forall a b. a -> Either a b
Left (TypeRep
t1,TypeRep
t2)
                          Just TypeRep
t  -> forall a b. b -> Either a b
Right TypeRep
t
  (Left (TypeRep, TypeRep)
e, Either (TypeRep, TypeRep) TypeRep
_) -> forall a b. a -> Either a b
Left (TypeRep, TypeRep)
e
  (Either (TypeRep, TypeRep) TypeRep
_, Left (TypeRep, TypeRep)
e) -> forall a b. a -> Either a b
Left (TypeRep, TypeRep)
e

-- | /O(n)/.
-- Returns 'Just' the type of an expression
-- or 'Nothing' when there is an error.
--
-- > > let one = val (1 :: Int)
-- > > let bee = val 'b'
-- > > let absE = value "abs" (abs :: Int -> Int)
--
-- > > mtyp one
-- > Just Int
--
-- > > mtyp (absE :$ bee)
-- > Nothing
mtyp :: Expr -> Maybe TypeRep
mtyp :: Expr -> Maybe TypeRep
mtyp  =  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Either (TypeRep, TypeRep) TypeRep
etyp

-- | /O(n)/.
-- Returns whether the given 'Expr' is ill typed.
-- (cf. 'isWellTyped')
--
-- > > let one = val (1 :: Int)
-- > > let bee = val 'b'
-- > > let absE = value "abs" (abs :: Int -> Int)
--
-- > > isIllTyped (absE :$ val (1 :: Int))
-- > False
--
-- > > isIllTyped (absE :$ val 'b')
-- > True
isIllTyped :: Expr -> Bool
isIllTyped :: Expr -> Bool
isIllTyped  =  forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Maybe TypeRep
mtyp

-- | /O(n)/.
-- Returns whether the given 'Expr' is well typed.
-- (cf. 'isIllTyped')
--
-- > > isWellTyped (absE :$ val (1 :: Int))
-- > True
--
-- > > isWellTyped (absE :$ val 'b')
-- > False
isWellTyped :: Expr -> Bool
isWellTyped :: Expr -> Bool
isWellTyped  =  forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Maybe TypeRep
mtyp

-- | /O(n)/.
-- Returns whether the given 'Expr' is of a functional type.
-- This is the same as checking if the 'arity' of the given 'Expr' is non-zero.
--
-- > > isFun (value "abs" (abs :: Int -> Int))
-- > True
--
-- > > isFun (val (1::Int))
-- > False
--
-- > > isFun (value "const" (const :: Bool -> Bool -> Bool) :$ val False)
-- > True
isFun :: Expr -> Bool
isFun :: Expr -> Bool
isFun  =  TypeRep -> Bool
isFunTy forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> TypeRep
typ

-- |  /O(n)/.
-- 'Just' the value of an expression when possible (correct type),
-- 'Nothing' otherwise.
-- This does not catch errors from 'undefined' 'Dynamic' 'value's.
--
-- > > let one = val (1 :: Int)
-- > > let bee = val 'b'
-- > > let negateE = value "negate" (negate :: Int -> Int)
--
-- > > evaluate one :: Maybe Int
-- > Just 1
--
-- > > evaluate one :: Maybe Char
-- > Nothing
--
-- > > evaluate bee :: Maybe Int
-- > Nothing
--
-- > > evaluate bee :: Maybe Char
-- > Just 'b'
--
-- > > evaluate $ negateE :$ one :: Maybe Int
-- > Just (-1)
--
-- > > evaluate $ negateE :$ bee :: Maybe Int
-- > Nothing
evaluate :: Typeable a => Expr -> Maybe a
evaluate :: forall a. Typeable a => Expr -> Maybe a
evaluate Expr
e = Expr -> Maybe Dynamic
toDynamic Expr
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Typeable a => Dynamic -> Maybe a
fromDynamic

-- | /O(n)/.
-- Evaluates an expression when possible (correct type).
-- Returns a default value otherwise.
--
-- > > let two = val (2 :: Int)
-- > > let three = val (3 :: Int)
-- > > let e1 -+- e2 = value "+" ((+) :: Int->Int->Int) :$ e1 :$ e2
--
-- > > eval 0 $ two -+- three :: Int
-- > 5
--
-- > > eval 'z' $ two -+- three :: Char
-- > 'z'
--
-- > > eval 0 $ two -+- val '3' :: Int
-- > 0
eval :: Typeable a => a -> Expr -> a
eval :: forall a. Typeable a => a -> Expr -> a
eval a
x Expr
e = forall a. a -> Maybe a -> a
fromMaybe a
x (forall a. Typeable a => Expr -> Maybe a
evaluate Expr
e)

-- | /O(n)/.
-- Evaluates an expression when possible (correct type).
-- Raises an error otherwise.
--
-- > > evl $ two -+- three :: Int
-- > 5
--
-- > > evl $ two -+- three :: Bool
-- > *** Exception: evl: cannot evaluate Expr `2 + 3 :: Int' at the Bool type
--
-- This may raise errors, please consider using 'eval' or 'evaluate'.
evl :: Typeable a => Expr -> a
evl :: forall a. Typeable a => Expr -> a
evl Expr
e = a
r
  where
  r :: a
r = forall a. Typeable a => a -> Expr -> a
eval a
err Expr
e
  err :: a
err = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"evl: cannot evaluate Expr `" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Expr
e forall a. [a] -> [a] -> [a]
++ String
"' at the " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Typeable a => a -> TypeRep
typeOf a
r) forall a. [a] -> [a] -> [a]
++ String
" type"

-- | /O(n)/.
-- Evaluates an expression to a terminal 'Dynamic' value when possible.
-- Returns 'Nothing' otherwise.
--
-- > > toDynamic $ val (123 :: Int) :: Maybe Dynamic
-- > Just <<Int>>
--
-- > > toDynamic $ value "abs" (abs :: Int -> Int) :$ val (-1 :: Int)
-- > Just <<Int>>
--
-- > > toDynamic $ value "abs" (abs :: Int -> Int) :$ val 'a'
-- > Nothing
toDynamic :: Expr -> Maybe Dynamic
toDynamic :: Expr -> Maybe Dynamic
toDynamic (Value String
_ Dynamic
x) = forall a. a -> Maybe a
Just Dynamic
x
toDynamic (Expr
e1 :$ Expr
e2)  = do Dynamic
v1 <- Expr -> Maybe Dynamic
toDynamic Expr
e1
                           Dynamic
v2 <- Expr -> Maybe Dynamic
toDynamic Expr
e2
                           Dynamic -> Dynamic -> Maybe Dynamic
dynApply Dynamic
v1 Dynamic
v2

-- | Shows 'Expr's with their types.
--
-- > > show (value "not" not :$ val False)
-- > "not False :: Bool"
instance Show Expr where
  showsPrec :: Int -> Expr -> ShowS
showsPrec Int
d Expr
e = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
                forall a b. (a -> b) -> a -> b
$ Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
e
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" :: "
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ShowS
showsTypeExpr Expr
e

showsTypeExpr :: Expr -> String -> String
showsTypeExpr :: Expr -> ShowS
showsTypeExpr Expr
e = case Expr -> Either (TypeRep, TypeRep) TypeRep
etyp Expr
e of
  Left (TypeRep
t1,TypeRep
t2) -> String -> ShowS
showString String
"ill-typed # "
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows TypeRep
t1
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" $ "
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows TypeRep
t2
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" #"
  Right TypeRep
t -> forall a. Show a => a -> ShowS
shows TypeRep
t

showsPrecExpr :: Int -> Expr -> String -> String
showsPrecExpr :: Int -> Expr -> ShowS
showsPrecExpr Int
d (Value String
"_" Dynamic
_) = String -> ShowS
showString String
"_" -- a hole
showsPrecExpr Int
d (Value (Char
'_':String
s) Dynamic
_)  -- a variable
  | String -> Bool
isInfixedPrefix String
s = String -> ShowS
showString forall a b. (a -> b) -> a -> b
$ ShowS
toPrefix String
s
  | Bool
otherwise         = Bool -> ShowS -> ShowS
showParen (String -> Bool
isInfix String
s) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
s
showsPrecExpr Int
d (Value String
s Dynamic
_) | String -> Bool
isInfixedPrefix String
s = String -> ShowS
showString forall a b. (a -> b) -> a -> b
$ ShowS
toPrefix String
s
showsPrecExpr Int
d (Value String
s Dynamic
_) | String -> Bool
isNegativeLiteral String
s = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
s
showsPrecExpr Int
d (Value String
s Dynamic
_) = Bool -> ShowS -> ShowS
showParen Bool
sp forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
s
  where sp :: Bool
sp = if String -> Bool
atomic String
s then String -> Bool
isInfix String
s else forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Int
d forall a. Ord a => a -> a -> Bool
>) forall a b. (a -> b) -> a -> b
$ String -> Maybe Int
outernmostPrec String
s
showsPrecExpr Int
d (Value String
":" Dynamic
_ :$ Expr
e1 :$ Expr
e2)
  | Expr -> Bool
isConst Expr
e1 Bool -> Bool -> Bool
&& Expr -> Maybe TypeRep
mtyp Expr
e1 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Char)) =
  case Expr -> ShowS
showsTailExpr Expr
e2 String
"" of
    Char
'\"':String
cs  -> String -> ShowS
showString (String
"\"" forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail) (Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
e1 String
"") forall a. [a] -> [a] -> [a]
++ String
cs)
    String
cs -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> String -> Int
prec String
":")
        forall a b. (a -> b) -> a -> b
$ String -> Expr -> ShowS
showsOpExpr String
":" Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
cs
showsPrecExpr Int
d (Value String
":" Dynamic
_ :$ Expr
e1 :$ Expr
e2) =
  case Expr -> ShowS
showsTailExpr Expr
e2 String
"" of
    String
"[]" -> String -> ShowS
showString String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
    Char
'[':String
cs -> String -> ShowS
showString String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
cs
    String
cs -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> String -> Int
prec String
":")
        forall a b. (a -> b) -> a -> b
$ String -> Expr -> ShowS
showsOpExpr String
":" Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
cs
showsPrecExpr Int
d Expr
ee | Expr -> Bool
isTuple Expr
ee = Bool -> ShowS -> ShowS
showParen Bool
True
                                forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\ShowS
s1 ShowS
s2 -> ShowS
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2)
                                         (Int -> Expr -> ShowS
showsPrecExpr Int
0 forall a b. (a -> b) -> [a] -> [b]
`map` Expr -> [Expr]
unfoldTuple Expr
ee)
showsPrecExpr Int
d (Value String
"if" Dynamic
_ :$ Expr
ep :$ Expr
ex :$ Expr
ey) =
  Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"if "    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ep
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" then " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ex
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" else " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ey
showsPrecExpr Int
d (Value String
"case" Dynamic
_ :$ Expr
ep :$ Expr
ex :$ Expr
ey) | Expr -> TypeRep
typ Expr
ep forall a. Eq a => a -> a -> Bool
== TypeRep
boolTy =
  Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"case "         forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ep
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" of False -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ex
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; True -> "    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ey
showsPrecExpr Int
d (Value String
"case" Dynamic
_ :$ Expr
eo :$ Expr
ex :$ Expr
ey :$ Expr
ez) | Expr -> TypeRep
typ Expr
eo forall a. Eq a => a -> a -> Bool
== TypeRep
orderingTy =
  Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"case "      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
eo
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" of LT -> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ex
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; EQ -> "   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ey
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"; GT -> "   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ez
showsPrecExpr Int
d (Value String
",.." Dynamic
_ :$ Expr
ex :$ Expr
ey :$ Expr
ez) =
  String -> ShowS
showString String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ex
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (if Expr -> Bool
dotdot Expr
ex Bool -> Bool -> Bool
&& Expr -> Bool
dotdot Expr
ey Bool -> Bool -> Bool
&& Expr -> Bool
dotdot Expr
ez then String
"," else String
", ")
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ey
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (if Expr -> Bool
dotdot Expr
ex Bool -> Bool -> Bool
&& Expr -> Bool
dotdot Expr
ey Bool -> Bool -> Bool
&& Expr -> Bool
dotdot Expr
ez then String
".." else String
" .. ")
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ez
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
showsPrecExpr Int
d (Value String
",.." Dynamic
_ :$ Expr
ex :$ Expr
ey) =
  String -> ShowS
showString String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ex
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (if Expr -> Bool
dotdot Expr
ex Bool -> Bool -> Bool
&& Expr -> Bool
dotdot Expr
ey then String
"," else String
", ")
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ey
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (if Expr -> Bool
dotdot Expr
ex Bool -> Bool -> Bool
&& Expr -> Bool
dotdot Expr
ey then String
"..]" else String
" ..]")
showsPrecExpr Int
d (Value String
".." Dynamic
_ :$ Expr
ex :$ Expr
ey) =
  String -> ShowS
showString String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ex
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (if Expr -> Bool
dotdot Expr
ex Bool -> Bool -> Bool
&& Expr -> Bool
dotdot Expr
ey then String
".." else String
" .. ")
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ey
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
showsPrecExpr Int
d (Value String
".." Dynamic
_ :$ Expr
ex) =
  String -> ShowS
showString String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
ex forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (if Expr -> Bool
dotdot Expr
ex then String
"..]" else String
" ..]")
showsPrecExpr Int
d (Value String
f' Dynamic
_ :$ Expr
e1 :$ Expr
e2)
  | String -> Bool
isInfix String
f = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> String -> Int
prec String
f)
              forall a b. (a -> b) -> a -> b
$ String -> Expr -> ShowS
showsOpExpr String
f Expr
e1
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Expr -> ShowS
showsOpExpr String
f Expr
e2
  | Bool
otherwise = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> String -> Int
prec String
" ")
              forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
f
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Expr -> ShowS
showsOpExpr String
" " Expr
e1
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Expr -> ShowS
showsOpExpr String
" " Expr
e2
  where
  f :: String
f = case String
f' of String
"_" -> String
"_"   -- holes are shown as _
                 (Char
'_':String
f) -> String
f -- on variables we drop the preceding _
                 String
f -> String
f       -- constants as themselves
showsPrecExpr Int
d (Value String
f' Dynamic
_ :$ Expr
e1)
  | String -> Bool
isInfix String
f = Bool -> ShowS -> ShowS
showParen Bool
True forall a b. (a -> b) -> a -> b
$ String -> Expr -> ShowS
showsOpExpr String
f Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
f
  where
  f :: String
f = case String
f' of String
"_" -> String
"_"   -- holes are shown as _
                 (Char
'_':String
f) -> String
f -- on variables we drop the preceding _
                 String
f -> String
f       -- constants as themselves
showsPrecExpr Int
d (Expr
e1 :$ Expr
e2) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> String -> Int
prec String
" ")
                           forall a b. (a -> b) -> a -> b
$ Int -> Expr -> ShowS
showsPrecExpr (String -> Int
prec String
" ") Expr
e1
                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
                           forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr (String -> Int
prec String
" " forall a. Num a => a -> a -> a
+ Int
1) Expr
e2

-- Can we avoid a space using @[<n>..<m>]@?
dotdot :: Expr -> Bool
dotdot :: Expr -> Bool
dotdot (Value (Char
c:String
_) Dynamic
_)  =  Char -> Bool
isNumber Char
c Bool -> Bool -> Bool
|| Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''
dotdot Expr
_  =  Bool
False

-- bad smell here, repeated code!
showsTailExpr :: Expr -> String -> String
showsTailExpr :: Expr -> ShowS
showsTailExpr (Value String
":" Dynamic
_ :$ Expr
e1 :$ Expr
e2)
  | Expr -> Bool
isConst Expr
e1 Bool -> Bool -> Bool
&& Expr -> Maybe TypeRep
mtyp Expr
e1 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall a. Typeable a => a -> TypeRep
typeOf (forall a. HasCallStack => a
undefined :: Char)) =
  case Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
e2 String
"" of
    Char
'\"':String
cs  -> String -> ShowS
showString (String
"\"" forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail) (Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
e1 String
"") forall a. [a] -> [a] -> [a]
++ String
cs)
    String
cs -> String -> Expr -> ShowS
showsOpExpr String
":" Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ShowS
showsTailExpr Expr
e2
showsTailExpr (Value String
":" Dynamic
_ :$ Expr
e1 :$ Expr
e2) =
  case Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
e2 String
"" of
    String
"[]" -> String -> ShowS
showString String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]"
    Char
'[':String
cs -> String -> ShowS
showString String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr -> ShowS
showsPrecExpr Int
0 Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
cs
    String
cs -> String -> Expr -> ShowS
showsOpExpr String
":" Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> ShowS
showsTailExpr Expr
e2
showsTailExpr Expr
e = String -> Expr -> ShowS
showsOpExpr String
":" Expr
e

showsOpExpr :: String -> Expr -> String -> String
showsOpExpr :: String -> Expr -> ShowS
showsOpExpr String
op = Int -> Expr -> ShowS
showsPrecExpr (String -> Int
prec String
op forall a. Num a => a -> a -> a
+ Int
1)

-- | /O(n)/.
-- Like 'showPrecExpr' but
-- the precedence is taken from the given operator name.
--
-- > > showOpExpr "*" (two -*- three)
-- > "(2 * 3)"
--
-- > > showOpExpr "+" (two -*- three)
-- > "2 * 3"
--
-- To imply that the surrounding environment is a function application,
-- use @" "@ as the given operator.
--
-- > > showOpExpr " " (two -*- three)
-- > "(2 * 3)"
showOpExpr :: String -> Expr -> String
showOpExpr :: String -> Expr -> String
showOpExpr String
op = Int -> Expr -> String
showPrecExpr (String -> Int
prec String
op forall a. Num a => a -> a -> a
+ Int
1)

-- | /O(n)/.
-- Like 'showExpr' but allows specifying the surrounding precedence.
--
-- > > showPrecExpr 6 (one -+- two)
-- > "1 + 2"
--
-- > > showPrecExpr 7 (one -+- two)
-- > "(1 + 2)"
showPrecExpr :: Int -> Expr -> String
showPrecExpr :: Int -> Expr -> String
showPrecExpr Int
n Expr
e = Int -> Expr -> ShowS
showsPrecExpr Int
n Expr
e String
""

-- | /O(n)/.
-- Returns a string representation of an expression.
-- Differently from 'show' (@:: Expr -> String@)
-- this function does not include the type in the output.
--
-- > > putStrLn $ showExpr (one -+- two)
-- > 1 + 2
--
-- > > putStrLn $ showExpr $ (pp -||- true) -&&- (qq -||- false)
-- > (p || True) && (q || False)
showExpr :: Expr -> String
showExpr :: Expr -> String
showExpr = Int -> Expr -> String
showPrecExpr (-Int
1)

-- | /O(n)/.
-- Does not evaluate values when comparing, but rather uses their
-- representation as strings and their types.
--
-- This instance works for ill-typed expressions.
instance Eq Expr where
  Value String
s1 Dynamic
d1  == :: Expr -> Expr -> Bool
== Value String
s2 Dynamic
d2   =  String
s1 forall a. Eq a => a -> a -> Bool
== String
s2 Bool -> Bool -> Bool
&& Dynamic -> TypeRep
dynTypeRep Dynamic
d1 forall a. Eq a => a -> a -> Bool
== Dynamic -> TypeRep
dynTypeRep Dynamic
d2
  (Expr
ef1 :$ Expr
ex1) == (Expr
ef2 :$ Expr
ex2)  =  Expr
ef1 forall a. Eq a => a -> a -> Bool
== Expr
ef2 Bool -> Bool -> Bool
&& Expr
ex1 forall a. Eq a => a -> a -> Bool
== Expr
ex2
  Expr
_            == Expr
_             =  Bool
False

-- | /O(n)/.
-- Does not evaluate values when comparing, but rather uses their
-- representation as strings and their types.
--
-- This instance works for ill-typed expressions.
--
-- Expressions come first
-- when they have smaller complexity ('compareComplexity')
-- or when they come first lexicographically ('compareLexicographically').
instance Ord Expr where
  compare :: Expr -> Expr -> Ordering
compare = Expr -> Expr -> Ordering
compareComplexity forall a. Semigroup a => a -> a -> a
<> Expr -> Expr -> Ordering
compareLexicographically

-- | /O(n)/.
-- Compares the complexity of two 'Expr's.
-- An expression /e1/ is /strictly simpler/ than another expression /e2/
-- if the first of the following conditions to distingish between them is:
--
-- 1. /e1/ is smaller in size\/length than /e2/,
--    e.g.: @x + y < x + (y + z)@;
--
-- 2. or, /e1/ has more distinct variables than /e2/,
--    e.g.: @x + y < x + x@;
--
-- 3. or, /e1/ has more variable occurrences than /e2/,
--    e.g.: @x + x < 1 + x@;
--
-- 4. or, /e1/ has fewer distinct constants than /e2/,
--    e.g.: @1 + 1 < 0 + 1@.
--
-- They're otherwise considered of equal complexity,
-- e.g.: @x + y@ and @y + z@.
--
-- > > (xx -+- yy) `compareComplexity` (xx -+- (yy -+- zz))
-- > LT
--
-- > > (xx -+- yy) `compareComplexity` (xx -+- xx)
-- > LT
--
-- > > (xx -+- xx) `compareComplexity` (one -+- xx)
-- > LT
--
-- > > (one -+- one) `compareComplexity` (zero -+- one)
-- > LT
--
-- > > (xx -+- yy) `compareComplexity` (yy -+- zz)
-- > EQ
--
-- > > (zero -+- one) `compareComplexity` (one -+- zero)
-- > EQ
--
-- This comparison is not a total order.
compareComplexity :: Expr -> Expr -> Ordering
compareComplexity :: Expr -> Expr -> Ordering
compareComplexity  =  (forall a. Ord a => a -> a -> Ordering
compare      forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
values)
                   forall a. Semigroup a => a -> a -> a
<> (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
nubVars)
                   forall a. Semigroup a => a -> a -> a
<> (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
vars)
                   forall a. Semigroup a => a -> a -> a
<> (forall a. Ord a => a -> a -> Ordering
compare      forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
nubConsts)

-- | /O(n)./
-- Lexicographical structural comparison of 'Expr's
-- where variables < constants < applications
-- then types are compared before string representations.
--
-- > > compareLexicographically one (one -+- one)
-- > LT
-- > > compareLexicographically one zero
-- > GT
-- > > compareLexicographically (xx -+- zero) (zero -+- xx)
-- > LT
-- > > compareLexicographically (zero -+- xx) (zero -+- xx)
-- > EQ
--
-- (cf. 'compareTy')
--
-- This comparison is a total order.
compareLexicographically :: Expr -> Expr -> Ordering
compareLexicographically :: Expr -> Expr -> Ordering
compareLexicographically  =  Expr -> Expr -> Ordering
cmp
  where
  (Expr
f :$ Expr
x) cmp :: Expr -> Expr -> Ordering
`cmp` (Expr
g :$ Expr
y)  =  Expr
f  Expr -> Expr -> Ordering
`cmp` Expr
g forall a. Semigroup a => a -> a -> a
<> Expr
x Expr -> Expr -> Ordering
`cmp` Expr
y
  (Expr
_ :$ Expr
_) `cmp` Expr
_         =  Ordering
GT
  Expr
_        `cmp` (Expr
_ :$ Expr
_)  =  Ordering
LT
  e1 :: Expr
e1@(Value String
s1 Dynamic
_) `cmp` e2 :: Expr
e2@(Value String
s2 Dynamic
_)  =  Expr -> Bool
isConst Expr
e1 forall a. Ord a => a -> a -> Ordering
`compare` Expr -> Bool
isConst Expr
e2 -- var<const
                                         forall a. Semigroup a => a -> a -> a
<> Expr -> TypeRep
typ Expr
e1 TypeRep -> TypeRep -> Ordering
`compareTy` Expr -> TypeRep
typ Expr
e2
                                         forall a. Semigroup a => a -> a -> a
<> String
s1 String -> String -> Ordering
`cmpbool` String
s2 -- False<True
                                         forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s1 forall a. Ord a => a -> a -> Ordering
`compare` forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s2 -- 2<10
                                         forall a. Semigroup a => a -> a -> a
<> String
s1 forall a. Ord a => a -> a -> Ordering
`compare` String
s2
  String
"False" cmpbool :: String -> String -> Ordering
`cmpbool` String
"True"   =  Ordering
LT
  String
"True"  `cmpbool` String
"False"  =  Ordering
GT
  String
_       `cmpbool` String
_        =  Ordering
EQ

-- | /O(n)./
-- A fast total order between 'Expr's
-- that can be used when sorting 'Expr' values.
--
-- This is lazier than its counterparts
-- 'compareComplexity' and 'compareLexicographically'
-- and tries to evaluate the given 'Expr's as least as possible.
compareQuickly :: Expr -> Expr -> Ordering
compareQuickly :: Expr -> Expr -> Ordering
compareQuickly  =  Expr -> Expr -> Ordering
cmp
  where
  (Expr
f :$ Expr
x)       cmp :: Expr -> Expr -> Ordering
`cmp` (Expr
g :$ Expr
y)        =  Expr
f  Expr -> Expr -> Ordering
`cmp` Expr
g forall a. Semigroup a => a -> a -> a
<> Expr
x Expr -> Expr -> Ordering
`cmp` Expr
y
  (Expr
_ :$ Expr
_)       `cmp` Expr
_               =  Ordering
GT
  Expr
_              `cmp` (Expr
_ :$ Expr
_)        =  Ordering
LT
  x :: Expr
x@(Value String
n1 Dynamic
_) `cmp` y :: Expr
y@(Value String
n2 Dynamic
_)  =  Expr -> TypeRep
typ Expr
x TypeRep -> TypeRep -> Ordering
`compareTy` Expr -> TypeRep
typ Expr
y
                                       forall a. Semigroup a => a -> a -> a
<> String
n1 forall a. Ord a => a -> a -> Ordering
`compare` String
n2

-- | /O(n)/.
-- Unfold a function application 'Expr' into a list of function and
-- arguments.
--
-- > unfoldApp $ e0                    =  [e0]
-- > unfoldApp $ e0 :$ e1              =  [e0,e1]
-- > unfoldApp $ e0 :$ e1 :$ e2        =  [e0,e1,e2]
-- > unfoldApp $ e0 :$ e1 :$ e2 :$ e3  =  [e0,e1,e2,e3]
--
-- Remember ':$' is left-associative, so:
--
-- > unfoldApp e0                          =  [e0]
-- > unfoldApp (e0 :$ e1)                  =  [e0,e1]
-- > unfoldApp ((e0 :$ e1) :$ e2)          =  [e0,e1,e2]
-- > unfoldApp (((e0 :$ e1) :$ e2) :$ e3)  =  [e0,e1,e2,e3]
unfoldApp :: Expr -> [Expr]
unfoldApp :: Expr -> [Expr]
unfoldApp Expr
e  =  Expr -> [Expr] -> [Expr]
u Expr
e []
  where
  u :: Expr -> [Expr] -> [Expr]
u (Expr
ef :$ Expr
ex) = Expr -> [Expr] -> [Expr]
u Expr
ef forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr
exforall a. a -> [a] -> [a]
:)
  u Expr
ex         = (Expr
exforall a. a -> [a] -> [a]
:)

-- | /O(n)/.
-- Unfold a tuple 'Expr' into a list of values.
--
-- > > let pair' a b = value "," ((,) :: Bool->Char->(Bool,Char)) :$ a :$ b
--
-- > > pair' (val True) (val 'a')
-- > (True,'a') :: (Bool,Char)
--
-- > > unfoldTuple $ pair' (val True) (val 'a')
-- > [True :: Bool,'a' :: Char]
--
-- > > let trio' a b c = value ",," ((,,) :: Bool->Char->Int->(Bool,Char,Int)) :$ a :$ b :$ c
--
-- > > trio' (val False) (val 'b') (val (9 :: Int))
-- > (False,'b',9) :: (Bool,Char,Int)
--
-- > > unfoldTuple $ trio' (val False) (val 'b') (val (9 :: Int))
-- > [False :: Bool,'b' :: Char,9 :: Int]
--
-- NOTE: this function returns an empty list when the representation of the
--       tupling function is @(,)@, @(,,)@, @(,,,)@ or @(,,,...)@.
--       This is intentional, allowing the 'Show' 'Expr' instance
--       to present @(,) 1 2@ differently than @(1,2)@.
unfoldTuple :: Expr -> [Expr]
unfoldTuple :: Expr -> [Expr]
unfoldTuple = [Expr] -> [Expr]
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
unfoldApp
  where
  u :: [Expr] -> [Expr]
u (Value String
cs Dynamic
_:[Expr]
es) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr]
es) Bool -> Bool -> Bool
&& String
cs forall a. Eq a => a -> a -> Bool
== forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
es forall a. Num a => a -> a -> a
- Int
1) Char
',' = [Expr]
es
  u [Expr]
_   = []

isTuple :: Expr -> Bool
isTuple :: Expr -> Bool
isTuple = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
unfoldTuple

-- | /O(n)/.
-- Check if an 'Expr' has a variable.  (By convention, any value whose
-- 'String' representation starts with @'_'@.)
--
-- > > hasVar $ value "not" not :$ val True
-- > False
--
-- > > hasVar $ value "&&" (&&) :$ var "p" (undefined :: Bool) :$ val True
-- > True
hasVar :: Expr -> Bool
hasVar :: Expr -> Bool
hasVar (Expr
e1 :$ Expr
e2)  =  Expr -> Bool
hasVar Expr
e1 Bool -> Bool -> Bool
|| Expr -> Bool
hasVar Expr
e2
hasVar Expr
e           =  Expr -> Bool
isVar Expr
e

-- | /O(n)/.
-- Returns whether a 'Expr' has /no/ variables.
-- This is equivalent to "@not . hasVar@".
--
-- The name "ground" comes from term rewriting.
--
-- > > isGround $ value "not" not :$ val True
-- > True
--
-- > > isGround $ value "&&" (&&) :$ var "p" (undefined :: Bool) :$ val True
-- > False
isGround :: Expr -> Bool
isGround :: Expr -> Bool
isGround  =  Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Bool
hasVar

-- | /O(1)/.
-- Returns whether an 'Expr' is a terminal constant.
-- (cf. 'isGround').
--
-- > > isConst $ var "x" (undefined :: Int)
-- > False
--
-- > > isConst $ val False
-- > True
--
-- > > isConst $ value "not" not :$ val False
-- > False
isConst :: Expr -> Bool
isConst :: Expr -> Bool
isConst  (Value (Char
'_':String
_) Dynamic
_)  =  Bool
False
isConst  (Value String
_ Dynamic
_)        =  Bool
True
isConst  Expr
_                  =  Bool
False

-- | /O(1)/.
-- Returns whether an 'Expr' is a terminal variable ('var').
-- (cf. 'hasVar').
--
-- > > isVar $ var "x" (undefined :: Int)
-- > True
--
-- > > isVar $ val False
-- > False
--
-- > > isVar $ value "not" not :$ var "p" (undefined :: Bool)
-- > False
isVar :: Expr -> Bool
isVar :: Expr -> Bool
isVar (Value (Char
'_':String
_) Dynamic
_)  =  Bool
True
isVar Expr
_                  =  Bool
False

-- | /O(1)/.
-- Returns whether an 'Expr' is a terminal value ('Value').
--
-- > > isValue $ var "x" (undefined :: Int)
-- > True
--
-- > > isValue $ val False
-- > True
--
-- > > isValue $ value "not" not :$ var "p" (undefined :: Bool)
-- > False
--
-- This is equivalent to pattern matching the 'Value' constructor.
--
-- /Properties:/
--
-- * @ isValue (Value e)  =  True @
--
-- * @ isValue (e1 :$ e2)  =  False @
--
-- * @ isValue  =  not . isApp @
--
-- * @ isValue e  =  isVar e || isConst e @
isValue :: Expr -> Bool
isValue :: Expr -> Bool
isValue (Value String
_ Dynamic
_)  =  Bool
True
isValue Expr
_            =  Bool
False

-- | /O(1)/.
-- Returns whether an 'Expr' is an application (':$').
--
-- > > isApp $ var "x" (undefined :: Int)
-- > False
--
-- > > isApp $ val False
-- > False
--
-- > > isApp $ value "not" not :$ var "p" (undefined :: Bool)
-- > True
--
-- This is equivalent to pattern matching the ':$' constructor.
--
-- /Properties:/
--
-- * @ isApp (e1 :$ e2)  =  True @
--
-- * @ isApp (Value e)  =  False @
--
-- * @ isApp  =  not . isValue @
--
-- * @ isApp e  =  not (isVar e) && not (isConst e) @
isApp :: Expr -> Bool
isApp :: Expr -> Bool
isApp (Expr
_ :$ Expr
_)  =  Bool
True
isApp Expr
_         =  Bool
False

-- | /O(n)/ for the spine, /O(n^2)/ for full evaluation.
-- Lists subexpressions of a given expression in order and with repetitions.
-- This includes the expression itself and partial function applications.
-- (cf. 'nubSubexprs')
--
-- > > subexprs (xx -+- yy)
-- > [ x + y :: Int
-- > , (x +) :: Int -> Int
-- > , (+) :: Int -> Int -> Int
-- > , x :: Int
-- > , y :: Int
-- > ]
--
-- > > subexprs (pp -&&- (pp -&&- true))
-- > [ p && (p && True) :: Bool
-- > , (p &&) :: Bool -> Bool
-- > , (&&) :: Bool -> Bool -> Bool
-- > , p :: Bool
-- > , p && True :: Bool
-- > , (p &&) :: Bool -> Bool
-- > , (&&) :: Bool -> Bool -> Bool
-- > , p :: Bool
-- > , True :: Bool
-- > ]
subexprs :: Expr -> [Expr]
subexprs :: Expr -> [Expr]
subexprs Expr
e  =  Expr -> [Expr] -> [Expr]
s Expr
e []
  where
  s :: Expr -> [Expr] -> [Expr]
  s :: Expr -> [Expr] -> [Expr]
s e :: Expr
e@(Expr
e1 :$ Expr
e2)  =  (Expr
eforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr] -> [Expr]
s Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr] -> [Expr]
s Expr
e2
  s Expr
e             =  (Expr
eforall a. a -> [a] -> [a]
:)

-- | /O(n^3)/ for full evaluation.
-- Lists all subexpressions of a given expression without repetitions.
-- This includes the expression itself and partial function applications.
-- (cf. 'subexprs')
--
-- > > nubSubexprs (xx -+- yy)
-- > [ x :: Int
-- > , y :: Int
-- > , (+) :: Int -> Int -> Int
-- > , (x +) :: Int -> Int
-- > , x + y :: Int
-- > ]
--
-- > > nubSubexprs (pp -&&- (pp -&&- true))
-- > [ p :: Bool
-- > , True :: Bool
-- > , (&&) :: Bool -> Bool -> Bool
-- > , (p &&) :: Bool -> Bool
-- > , p && True :: Bool
-- > , p && (p && True) :: Bool
-- > ]
--
-- Runtime averages to
-- /O(n^2 log n)/ on evenly distributed expressions
-- such as @(f x + g y) + (h z + f w)@;
-- and to /O(n^3)/ on deep expressions
-- such as @f (g (h (f (g (h x)))))@.
nubSubexprs :: Expr -> [Expr]
nubSubexprs :: Expr -> [Expr]
nubSubexprs  =  Expr -> [Expr]
s
  where
  s :: Expr -> [Expr]
s e :: Expr
e@(Expr
e1 :$ Expr
e2)  =  [Expr
e] forall a. Ord a => [a] -> [a] -> [a]
+++ Expr -> [Expr]
s Expr
e1 forall a. Ord a => [a] -> [a] -> [a]
+++ Expr -> [Expr]
s Expr
e2
  s Expr
e             =  [Expr
e]

-- | /O(n)/.
-- Lists all terminal values in an expression in order and with repetitions.
-- (cf. 'nubValues')
--
-- > > values (xx -+- yy)
-- > [ (+) :: Int -> Int -> Int
-- > , x :: Int
-- > , y :: Int
-- > ]
--
-- > > values (xx -+- (yy -+- zz))
-- > [ (+) :: Int -> Int -> Int
-- > , x :: Int
-- > , (+) :: Int -> Int -> Int
-- > , y :: Int
-- > , z :: Int
-- > ]
--
-- > > values (zero -+- (one -*- two))
-- > [ (+) :: Int -> Int -> Int
-- > , 0 :: Int
-- > , (*) :: Int -> Int -> Int
-- > , 1 :: Int
-- > , 2 :: Int
-- > ]
--
-- > > values (pp -&&- true)
-- > [ (&&) :: Bool -> Bool -> Bool
-- > , p :: Bool
-- > , True :: Bool
-- > ]
values :: Expr -> [Expr]
values :: Expr -> [Expr]
values Expr
e  =  Expr -> [Expr] -> [Expr]
v Expr
e []
  where
  v :: Expr -> [Expr] -> [Expr]
  v :: Expr -> [Expr] -> [Expr]
v (Expr
e1 :$ Expr
e2)  =  Expr -> [Expr] -> [Expr]
v Expr
e1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr] -> [Expr]
v Expr
e2
  v Expr
e           =  (Expr
eforall a. a -> [a] -> [a]
:)

-- | /O(n^2)/.
-- Lists all terminal values in an expression without repetitions.
-- (cf. 'values')
--
-- > > nubValues (xx -+- yy)
-- > [ x :: Int
-- > , y :: Int
-- > , (+) :: Int -> Int -> Int
-- ]
--
-- > > nubValues (xx -+- (yy -+- zz))
-- > [ x :: Int
-- > , y :: Int
-- > , z :: Int
-- > , (+) :: Int -> Int -> Int
-- > ]
--
-- > > nubValues (zero -+- (one -*- two))
-- > [ 0 :: Int
-- > , 1 :: Int
-- > , 2 :: Int
-- > , (*) :: Int -> Int -> Int
-- > , (+) :: Int -> Int -> Int
-- > ]
--
-- > > nubValues (pp -&&- pp)
-- > [ p :: Bool
-- > , (&&) :: Bool -> Bool -> Bool
-- > ]
--
-- Runtime averages to
-- /O(n log n)/ on evenly distributed expressions
-- such as @(f x + g y) + (h z + f w)@;
-- and to /O(n^2)/ on deep expressions
-- such as @f (g (h (f (g (h x)))))@.
nubValues :: Expr -> [Expr]
nubValues :: Expr -> [Expr]
nubValues  =  Expr -> [Expr]
v
  where
  v :: Expr -> [Expr]
v (Expr
e1 :$ Expr
e2)  =  Expr -> [Expr]
v Expr
e1 forall a. Ord a => [a] -> [a] -> [a]
+++ Expr -> [Expr]
v Expr
e2
  v Expr
e           =  [Expr
e]

-- | /O(n)/.
-- List terminal constants in an expression in order and with repetitions.
-- (cf. 'nubConsts')
--
-- > > consts (xx -+- yy)
-- > [ (+) :: Int -> Int -> Int ]
--
-- > > consts (xx -+- (yy -+- zz))
-- > [ (+) :: Int -> Int -> Int
-- > , (+) :: Int -> Int -> Int
-- > ]
--
-- > > consts (zero -+- (one -*- two))
-- > [ (+) :: Int -> Int -> Int
-- > , 0 :: Int
-- > , (*) :: Int -> Int -> Int
-- > , 1 :: Int
-- > , 2 :: Int
-- > ]
--
-- > > consts (pp -&&- true)
-- > [ (&&) :: Bool -> Bool -> Bool
-- > , True :: Bool
-- > ]
consts :: Expr -> [Expr]
consts :: Expr -> [Expr]
consts  =  forall a. (a -> Bool) -> [a] -> [a]
filter Expr -> Bool
isConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
values

-- | /O(n^2)/.
-- List terminal constants in an expression without repetitions.
-- (cf. 'consts')
--
-- > > nubConsts (xx -+- yy)
-- > [ (+) :: Int -> Int -> Int ]
--
-- > > nubConsts (xx -+- (yy -+- zz))
-- > [ (+) :: Int -> Int -> Int ]
--
-- > > nubConsts (pp -&&- true)
-- > [ True :: Bool
-- > , (&&) :: Bool -> Bool -> Bool
-- > ]
--
-- Runtime averages to
-- /O(n log n)/ on evenly distributed expressions
-- such as @(f x + g y) + (h z + f w)@;
-- and to /O(n^2)/ on deep expressions
-- such as @f (g (h (f (g (h x)))))@.
nubConsts :: Expr -> [Expr]
nubConsts :: Expr -> [Expr]
nubConsts  =  Expr -> [Expr]
c
  where
  c :: Expr -> [Expr]
c (Expr
e1 :$ Expr
e2)  =  Expr -> [Expr]
c Expr
e1 forall a. Ord a => [a] -> [a] -> [a]
+++ Expr -> [Expr]
c Expr
e2
  c Expr
e           =  [Expr
e | Expr -> Bool
isConst Expr
e]

-- | /O(n)/.
-- Lists all variables in an expression in order and with repetitions.
-- (cf. 'nubVars')
--
-- > > vars (xx -+- yy)
-- > [ x :: Int
-- > , y :: Int
-- > ]
--
-- > > vars (xx -+- (yy -+- xx))
-- > [ x :: Int
-- > , y :: Int
-- > , x :: Int
-- > ]
--
-- > > vars (zero -+- (one -*- two))
-- > []
--
-- > > vars (pp -&&- true)
-- > [p :: Bool]
vars :: Expr -> [Expr]
vars :: Expr -> [Expr]
vars  =  forall a. (a -> Bool) -> [a] -> [a]
filter Expr -> Bool
isVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
values

-- | /O(n^2)/.
-- Lists all variables in an expression without repetitions.
-- (cf. 'vars')
--
-- > > nubVars (yy -+- xx)
-- > [ x :: Int
-- > , y :: Int
-- > ]
--
-- > > nubVars (xx -+- (yy -+- xx))
-- > [ x :: Int
-- > , y :: Int
-- > ]
--
-- > > nubVars (zero -+- (one -*- two))
-- > []
--
-- > > nubVars (pp -&&- true)
-- > [p :: Bool]
--
-- Runtime averages to
-- /O(n log n)/ on evenly distributed expressions
-- such as @(f x + g y) + (h z + f w)@;
-- and to /O(n^2)/ on deep expressions
-- such as @f (g (h (f (g (h x)))))@.
nubVars :: Expr -> [Expr]
nubVars :: Expr -> [Expr]
nubVars  =  Expr -> [Expr]
v
  where
  v :: Expr -> [Expr]
v (Expr
e1 :$ Expr
e2)  =  Expr -> [Expr]
v Expr
e1 forall a. Ord a => [a] -> [a] -> [a]
+++ Expr -> [Expr]
v Expr
e2
  v Expr
e           =  [Expr
e | Expr -> Bool
isVar Expr
e]

-- | /O(n)/.
-- Return the arity of the given expression,
-- i.e. the number of arguments that its type takes.
--
-- > > arity (val (0::Int))
-- > 0
--
-- > > arity (val False)
-- > 0
--
-- > > arity (value "id" (id :: Int -> Int))
-- > 1
--
-- > > arity (value "const" (const :: Int -> Int -> Int))
-- > 2
--
-- > > arity (one -+- two)
-- > 0
arity :: Expr -> Int
arity :: Expr -> Int
arity  =  TypeRep -> Int
tyArity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> TypeRep
typ

-- | /O(n)/.
-- Returns the size of the given expression,
-- i.e. the number of terminal values in it.
--
-- > zero       =  val (0 :: Int)
-- > one        =  val (1 :: Int)
-- > two        =  val (2 :: Int)
-- > xx -+- yy  =  value "+" ((+) :: Int->Int->Int) :$ xx :$ yy
-- > abs' xx    =  value "abs" (abs :: Int->Int) :$ xx
--
-- > > size zero
-- > 1
--
-- > > size (one -+- two)
-- > 3
--
-- > > size (abs' one)
-- > 2
size :: Expr -> Int
size :: Expr -> Int
size  =  forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [Expr]
values

-- | /O(n)/.
-- Returns the maximum depth of a given expression
-- given by the maximum number of nested function applications.
-- Curried function application is counted /only once/,
-- i.e. the application of a two argument function
-- increases the depth of both its arguments by one.
-- (cf. 'height')
--
-- With
--
-- > zero       =  val (0 :: Int)
-- > one        =  val (1 :: Int)
-- > two        =  val (2 :: Int)
-- > xx -+- yy  =  value "+" ((+) :: Int->Int->Int) :$ xx :$ yy
-- > abs' xx    =  value "abs" (abs :: Int->Int) :$ xx
--
-- > > depth zero
-- > 1
--
-- > > depth (one -+- two)
-- > 2
--
-- > > depth (abs' one -+- two)
-- > 3
--
-- Flipping arguments of applications in any of the subterms
-- does not affect the result.
depth :: Expr -> Int
depth :: Expr -> Int
depth e :: Expr
e@(Expr
_:$Expr
_)  =  Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map Expr -> Int
depth forall a b. (a -> b) -> a -> b
$ Expr -> [Expr]
unfoldApp Expr
e)
depth Expr
_         =  Int
1

-- | /O(n)/.
-- Returns the maximum height of a given expression
-- given by the maximum number of nested function applications.
-- Curried function application is counted /each time/,
-- i.e. the application of a two argument function
-- increases the depth of its first argument by two
-- and of its second argument by one.
-- (cf. 'depth')
--
-- With:
--
-- > zero          =  val (0 :: Int)
-- > one           =  val (1 :: Int)
-- > two           =  val (2 :: Int)
-- > const' xx yy  =  value "const" (const :: Int->Int->Int) :$ xx :$ yy
-- > abs' xx       =  value "abs" (abs :: Int->Int) :$ xx
--
-- Then:
--
-- > > height zero
-- > 1
--
-- > > height (abs' one)
-- > 2
--
-- > > height ((const' one) two)
-- > 3
--
-- > > height ((const' (abs' one)) two)
-- > 4
--
-- > > height ((const' one) (abs' two))
-- > 3
--
-- Flipping arguments of applications in subterms
-- may change the result of the function.
height :: Expr -> Int
height :: Expr -> Int
height (Expr
e1 :$ Expr
e2)  =  Int
1 forall a. Num a => a -> a -> a
+ Expr -> Int
height Expr
e1 forall a. Ord a => a -> a -> a
`max` Expr -> Int
height Expr
e2
height Expr
_           =  Int
1