Copyright | (c) 2019-2024 Rudy Matela |
---|---|
License | 3-Clause BSD (see the file LICENSE) |
Maintainer | Rudy Matela <rudy@matela.com.br> |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Defines some Expr
fixtures to facilitate testing and playing around on
the REPL (GHCI).
Instead of having to write:
> value "&&" (&&) :$ (value "not" not :$ val True) :$ val False not True && False :: Bool
Using this module, we can just write:
> not' true -&&- false not True && False :: Bool
Instead of having to write:
> value "+" ((+)::Int->Int->Int) :$ (value "*" ((*)::Int->Int->Int) :$ var "x" (undefined::Int) :$ var "y" (undefined::Int)) :$ (value "*" ((*)::Int->Int->Int) :$ val (1::Int) :$ val (2::Int)) x * y + 1 * 2 :: Int
Using this module, we can just write:
> xx -*- yy -+- one -*- two x * y + 1 * 2 :: Int
Instead of having to write:
> value "||" (||) :$ (value "==" ((==)::Int->Int->Bool) :$ val (3::Int) :$ (value "+" ((+)::Int->Int->Int) :$ var "y" (undefined::Int) :$ val (1::Int))) :$ (value "not" not :$ val False) 3 == y + 1 || not False :: Bool
We can just write:
> (three -==- yy -+- one) -||- not' false x == y + 1 || not False :: Bool
This exports over a hundred symbols to be used mainly when writing unit tests or playing around on GHCi.
Since the Expr
type only allows monomorphic values,
encoded polymorphic values are monomorphized
usually to the Int
type.
Beware: lifted Expr
functions sometimes work for different types.
The current version does not have a rationale for types that are included:
you have to either try around on the REPL or look at the source to really know.
Synopsis
- module Data.Express
- b_ :: Expr
- pp :: Expr
- qq :: Expr
- rr :: Expr
- pp' :: Expr
- false :: Expr
- true :: Expr
- notE :: Expr
- orE :: Expr
- andE :: Expr
- implies :: Expr
- not' :: Expr -> Expr
- (-||-) :: Expr -> Expr -> Expr
- (-&&-) :: Expr -> Expr -> Expr
- (-==>-) :: Expr -> Expr -> Expr
- (-==-) :: Expr -> Expr -> Expr
- (-/=-) :: Expr -> Expr -> Expr
- (-<=-) :: Expr -> Expr -> Expr
- (-<-) :: Expr -> Expr -> Expr
- compare' :: Expr -> Expr -> Expr
- if' :: Expr -> Expr -> Expr -> Expr
- caseBool :: Expr -> Expr -> Expr -> Expr
- caseOrdering :: Expr -> Expr -> Expr -> Expr -> Expr
- i_ :: Expr
- xx :: Expr
- yy :: Expr
- zz :: Expr
- xx' :: Expr
- ii :: Expr
- jj :: Expr
- kk :: Expr
- ii' :: Expr
- ll :: Expr
- mm :: Expr
- nn :: Expr
- zero :: Expr
- one :: Expr
- two :: Expr
- three :: Expr
- four :: Expr
- five :: Expr
- six :: Expr
- seven :: Expr
- eight :: Expr
- nine :: Expr
- ten :: Expr
- eleven :: Expr
- twelve :: Expr
- minusOne :: Expr
- minusTwo :: Expr
- idE :: Expr
- negateE :: Expr
- absE :: Expr
- signumE :: Expr
- idInt :: Expr
- idBool :: Expr
- idChar :: Expr
- idInts :: Expr
- idBools :: Expr
- idString :: Expr
- id' :: Expr -> Expr
- const' :: Expr -> Expr -> Expr
- negate' :: Expr -> Expr
- abs' :: Expr -> Expr
- signum' :: Expr -> Expr
- plus :: Expr
- times :: Expr
- minus :: Expr
- (-+-) :: Expr -> Expr -> Expr
- (-*-) :: Expr -> Expr -> Expr
- divE :: Expr
- modE :: Expr
- quotE :: Expr
- remE :: Expr
- div' :: Expr -> Expr -> Expr
- mod' :: Expr -> Expr -> Expr
- quot' :: Expr -> Expr -> Expr
- rem' :: Expr -> Expr -> Expr
- ff :: Expr -> Expr
- ffE :: Expr
- gg :: Expr -> Expr
- ggE :: Expr
- hh :: Expr -> Expr
- hhE :: Expr
- oo :: Expr -> Expr -> Expr
- ooE :: Expr
- question :: Expr
- (-?-) :: Expr -> Expr -> Expr
- (-$-) :: Expr -> Expr -> Expr
- odd' :: Expr -> Expr
- even' :: Expr -> Expr
- c_ :: Expr
- cs_ :: Expr
- cc :: Expr
- dd :: Expr
- ccs :: Expr
- ae :: Expr
- bee :: Expr
- cee :: Expr
- dee :: Expr
- zed :: Expr
- zee :: Expr
- space :: Expr
- lineBreak :: Expr
- ord' :: Expr -> Expr
- ordE :: Expr
- is_ :: Expr
- xxs :: Expr
- yys :: Expr
- zzs :: Expr
- nil :: Expr
- emptyString :: Expr
- nilInt :: Expr
- nilBool :: Expr
- nilChar :: Expr
- cons :: Expr
- consInt :: Expr
- consBool :: Expr
- consChar :: Expr
- (-:-) :: Expr -> Expr -> Expr
- unit :: Expr -> Expr
- (-++-) :: Expr -> Expr -> Expr
- head' :: Expr -> Expr
- tail' :: Expr -> Expr
- null' :: Expr -> Expr
- length' :: Expr -> Expr
- init' :: Expr -> Expr
- elem' :: Expr -> Expr -> Expr
- sort' :: Expr -> Expr
- insert' :: Expr -> Expr -> Expr
- bs_ :: Expr
- pps :: Expr
- qqs :: Expr
- and' :: Expr -> Expr
- or' :: Expr -> Expr
- sum' :: Expr -> Expr
- product' :: Expr -> Expr
- appendInt :: Expr
- nothing :: Expr
- nothingInt :: Expr
- nothingBool :: Expr
- just :: Expr -> Expr
- justInt :: Expr
- justBool :: Expr
- comma :: Expr
- pair :: Expr -> Expr -> Expr
- (-|-) :: Expr -> Expr -> Expr
- triple :: Expr -> Expr -> Expr -> Expr
- quadruple :: Expr -> Expr -> Expr -> Expr -> Expr
- quintuple :: Expr -> Expr -> Expr -> Expr -> Expr -> Expr
- sixtuple :: Expr -> Expr -> Expr -> Expr -> Expr -> Expr -> Expr
- (-%-) :: Expr -> Expr -> Expr
- compose :: Expr
- mapE :: Expr
- (-.-) :: Expr -> Expr -> Expr
- map' :: Expr -> Expr -> Expr
- enumFrom' :: Expr -> Expr
- (-..) :: Expr -> () -> Expr
- enumFromTo' :: Expr -> Expr -> Expr
- (-..-) :: Expr -> Expr -> Expr
- enumFromThen' :: Expr -> Expr -> Expr
- (--..) :: (Expr, Expr) -> () -> Expr
- enumFromThenTo' :: Expr -> Expr -> Expr -> Expr
- (--..-) :: (Expr, Expr) -> Expr -> Expr
Convenience re-export
module Data.Express
Functions and values encoded as Expr or functions of Exprs
The naming rules are:
Int
s are encoded using their English names, e.g.:zero
,one
,two
;Char
s are encoded using their English names, e.g.:bee
,cee
,dee
;- 0-argument constructors are encoded in lowercase,
e.g.:
false
,true
,nothing
,just
; - lifted constructors are lowercased,
e.g.:
just
; - lifted functions are primed
e.g.:
id'
,negate'
,head'
; - lifted operators are surrounded by dashes,
e.g.:
-+-
,-*-
,-&&-
,-||-
,-:-
. - operators are encoded using their English names,
e.g.:
plus
,times
,cons
; - encoded functions are followed by
E
, e.g.:idE
,notE
,absE
; - variables have the first character duplicated,
e.g.:
xx
,yy
,xxs
; - encoded values may have the element type appended,
e.g.:
idInt
,idBool
,justInt
,nilChar
.
Unqualified polymorphic constructors and functions
have their element types bound to Int
.
There are exceptions to the above rules such as:
when a name would conflict with a Prelude function.
(e.g.: orE
and andE
)
Booleans
(-==>-) :: Expr -> Expr -> Expr infixr 0 Source #
The function ==>
lifted over Expr
s.
> false -==>- true False ==> True :: Bool
> evl $ false -==>- true :: Bool True
(-/=-) :: Expr -> Expr -> Expr infix 4 Source #
Constructs an inequation between two Expr
s.
> xx -/=- zero x /= 0 :: Bool
> cc -/=- ae c /= 'a' :: Bool
(-<=-) :: Expr -> Expr -> Expr infix 4 Source #
Constructs a less-than-or-equal inequation between two Expr
s.
> xx -<=- zero x <= 0 :: Bool
> cc -<=- ae c <= 'a' :: Bool
(-<-) :: Expr -> Expr -> Expr infix 4 Source #
Constructs a less-than inequation between two Expr
s.
> xx -<- zero x < 0 :: Bool
> cc -<- bee c < 'b' :: Bool
if' :: Expr -> Expr -> Expr -> Expr Source #
A function if :: Bool -> a -> a -> a
lifted over the Expr
type
that encodes if-then-else functionality.
This is properly displayed as an if-then-else.
> if' pp zero xx (if p then 0 else x) :: Int
> zz -*- if' pp xx yy z * (if p then x else y) :: Int
> if' pp false true -||- if' qq true false (if p then False else True) || (if q then True else False) :: Bool
> evl $ if' true (val 't') (val 'f') :: Char 't'
caseBool :: Expr -> Expr -> Expr -> Expr Source #
A function case :: Bool -> a -> a -> a
lifted over the Expr
type
that encodes case-of-False-True functionality.
This is properly displayed as a case-of-False-True expression.
> caseBool pp zero xx (case p of False -> 0; True -> x) :: Int
> zz -*- caseBool pp xx yy z * (case p of False -> x; True -> y) :: Int
> caseBool pp false true -||- caseBool qq true false (caseBool p of False -> False; True -> True) || (caseBool q of False -> True; True -> False) :: Bool
> evl $ caseBool true (val 'f') (val 't') :: Char 't'
By convention, the False
case comes before True
as False < True
and data Bool = False | True
.
When evaluating, this is equivalent to if with arguments reversed.
Instead of using this, you are perhaps better of using if encoded as an
expression. This is just here to be consistent with caseOrdering
.
caseOrdering :: Expr -> Expr -> Expr -> Expr -> Expr Source #
A function case :: Ordering -> a -> a -> a -> a
lifted over the Expr
type
that encodes case-of-LT-EQ-GT functionality.
This is properly displayed as a case-of-LT-EQ-GT expression.
(cf. caseBool
)
> caseOrdering (xx `compare'` yy) zero one two (case compare x y of LT -> 0; EQ -> 1; GT -> 2) :: Int
> evl $ caseOrdering (val EQ) (val 'l') (val 'e') (val 'g') :: Char 'e'
By convention cases are given in LT
, EQ
and GT
order
as LT < EQ < GT
and data Ordering = LT | EQ | GT
.
Integers
A variable function f
of 'Int -> Int' type lifted over the Expr
type.
> ff xx f x :: Int
> ff one f 1 :: Int
A variable function g
of 'Int -> Int' type lifted over the Expr
type.
> gg yy g y :: Int
> gg minusTwo gg (-2) :: Int
A variable function h
of 'Int -> Int' type lifted over the Expr
type.
> hh zz h z :: Int
oo :: Expr -> Expr -> Expr Source #
A variable binary operator o
lifted over the Expr
type.
Works for Int
, Bool
, Char
, [Int]
and String
.
> xx `oo` yy x `o` y :: Int
> pp `oo` qq p `o` q :: Bool
> xx `oo` qq *** Exception: oo: unhandled type: 1 :: Int, False :: Bool accepted types are: o :: Int -> Int -> Int o :: Bool -> Bool -> Bool o :: Char -> Char -> Char o :: [Int] -> [Int] -> [Int] o :: [Char] -> [Char] -> [Char]
(-?-) :: Expr -> Expr -> Expr Source #
A variable binary operator ?
lifted over the Expr
type.
Works for Int
, Bool
, Char
, [Int]
and String
.
> xx -?- yy x ? y :: Int
> pp -?- qq p ? q :: Bool
> xx -?- qq *** Exception: (-?-): unhandled type: 1 :: Int, False :: Bool accepted types are: (?) :: Int -> Int -> Int (?) :: Bool -> Bool -> Bool (?) :: Char -> Char -> Char (?) :: [Int] -> [Int] -> [Int] (?) :: [Char] -> [Char] -> [Char] (?) :: Int -> [Int] -> [Int] (?) :: Char -> [Char] -> [Char]
Chars
Lists
Maybes
Nothing
bound to the Maybe
Int
type encoded as an Expr
.
This is an alias to nothingInt
.
Tuples
Ratios
Higher order
Function composition encoded as an Expr
:
> compose (.) :: (Int -> Int) -> (Int -> Int) -> Int -> Int
Enum
enumFromTo' :: Expr -> Expr -> Expr Source #
enumFromTo
lifted over Expr
s
> enumFromTo' zero four enumFromTo 0 4 :: [Int]
(-..-) :: Expr -> Expr -> Expr Source #
enumFromTo
lifted over Expr
s but named as ".."
for pretty-printing.
> zero -..- four [0..4] :: [Int]
enumFromThen' :: Expr -> Expr -> Expr Source #
enumFromThen
lifted over Expr
s
> enumFromThen' zero ten enumFromThen 0 10 :: [Int]
(--..) :: (Expr, Expr) -> () -> Expr Source #
enumFromThen
lifted over Expr
s but named as ",.."
for pretty printing.
> (zero,ten) --.. () [0,10..] :: [Int]
enumFromThenTo' :: Expr -> Expr -> Expr -> Expr Source #
enumFromThenTo
lifted over Expr
s.
> enumFromThenTo' zero two ten enumFromThenTo 0 2 10 :: [Int]