8.5 Class and instance declarations

class Eq a where
  (==), (/=) :: a -> a -> Bool
  x /= y = not (x == y)
instance Eq Bool where
  False == False = True
  True  == True  = True
  _     == _     = False

Bool is an instance of the Eq class, with (==) defined as above.

Only types that are defined using the data or newtype mechanisms can be made instances of classes.

Classes can also be extended to form new classes. For example, the class Ord of types whose values are totally ordered is declared as an extension of Eq class.

In [1]:
class Eq a => Ord a where
  (<), (<=), (>), (>=) :: a -> a -> Bool
  min, max             :: a -> a -> a
  min x y | x <= y    = x
          | otherwise = y
  max x y | x <= y    = y
          | otherwise = x
In [2]:
instance Ord Bool where
  False < True = True
  _     < _    = False
  
  b <= c = (b < c) || (b == c)
  b >  c = c < b
  b >= c = c <= b

Derived instances

When new types are declared, it is usually appropriate to make them instances of a number of built-in classes using the "deriving" clause.

data Bool = False | True deriving (Eq, Ord, Show, Read)
In [21]:
False == False
Redundant ==
Found:
False == False
Why Not:
not False
Redundant ==
Found:
False == False
Why Not:
not False
True
In [4]:
False < True
True
In [5]:
show False
"False"
In [6]:
read "False" :: Bool
False

The use of :: Bool in the above example is necessary as the read function needs to know what type it needs to convert the string "False" into.

For the purposes of deriving instances of the Ord type, the ordering of the constructors of a type is determined by the position in the declaration. So, False would be "less-than" True

In the case of constructors that have arguments, the types of these arguments should also be instance of any derived classes.

For example, in

data Shape = Circle Float | Rect Float Float

to derive Shape as an equality type requires Float also as deriving equality type.

or in

data Maybe a = Nothing | Just a

to derive Maybe as an equality type, the type argument a should also derive equality.

In [52]:
data Shape = Circle Float | Rectangle Float Float deriving (Eq, Ord, Show)
In [53]:
Rectangle 1.0 4.0 == Rectangle 2.0 3.0
False
In [57]:
Rectangle 1.0 4.0 > Rectangle 2.0 3.0
-- Note this example works in interactive ghci on terminal; has some issues in jupyter lab
<interactive>:1:65-67: No instance nor default method for class operation >
In [58]:
Circle 3.6 == Circle 5.5
False
In [59]:
show (Circle 4.4)
"Circle 4.4"

8.6 Tautology Checker

Consider a language of propositions built up from basic values (False, True) and variables (A,B,...,Z) using "not", "and", "implication" and parentheses. For example the following are propositions:

A and not A
(A and B) -> A
A -> (A and B)
(A and (A -> B)) -> B

Recall from your Discrete Math class the meaning of such propositions (truth tables)

Step 1: Declare type for propositions

In [62]:
data Prop = Const Bool
  | Var Char
  | Not Prop
  | And Prop Prop
  | Imply Prop Prop deriving Show

Note that we do not need to define parentheses as we can use the inbuilt Haskell parentheses. Using this type, we can instantiate above propositions as follows:

In [63]:
p1 :: Prop
p1 = And (Var 'A') (Not (Var 'A'))

p2 :: Prop
p2 = Imply (And (Var 'A') (Var 'B')) (Var 'A')

p3 :: Prop
p3 = Imply (Var 'A') (And (Var 'A') (Var 'B'))

p4 :: Prop
p4 = Imply (And (Var 'A') (Imply (Var 'A') (Var 'B'))) (Var 'B')
In [64]:
show p4
"Imply (And (Var 'A') (Imply (Var 'A') (Var 'B'))) (Var 'B')"

Step 2: Define substitutions and eval

In [70]:
type Assoc k v = [(k,v)]
find :: Eq k => k -> Assoc k v -> v
find k t = head [v | (k',v) <- t, k == k']

type Subst = Assoc Char Bool

for example, the substitution [('A',False),('B',True)] assigns boolean values to variables. We can now define the following function, eval, which given a substitution and a proposition, evaluates the proposition based on the substitution to result in a boolean value.

In [71]:
eval :: Subst -> Prop -> Bool
eval _ (Const b)   = b
eval s (Var x)     = find x s
eval s (Not p)     = not (eval s p)
eval s (And p q)   = eval s p && eval s q
eval s (Imply p q) = eval s p <= eval s q
In [72]:
eval [('A',False),('B',True)] p2
True
In [73]:
eval [('A',True),('B',False)] p3
False

Step 3: Generate substitutions

In [74]:
-- function to return all variables in a proposition
vars :: Prop -> [Char]
vars (Const _)   = []
vars (Var x)     = [x]
vars (Not p)     = vars p
vars (And p q)   = vars p ++ vars q
vars (Imply p q) = vars p ++ vars q
Use String
Found:
Prop -> [Char]
Why Not:
Prop -> String
In [75]:
vars p1
vars p2
vars p2
vars p4
"AA"
"ABA"
"ABA"
"AABB"

Note: We will get rid of duplicates later

In [82]:
-- function to generate all combinations of False and True for n variables
-- method: think of each combination as an integer in binary notation with 0=False,1=True
type Bit = Int
int2bin :: Int -> [Bit]
int2bin 0 = []
int2bin n = n `mod` 2 : int2bin (n `div` 2)

bools1 :: Int -> [[Bool]]
bools1 n = map (reverse . map conv . make n . int2bin) range
  where 
    range     = [0..(2^n)-1]
    make n bs = take n (bs ++ repeat 0)
    conv 0    = False
    conv 1    = True
In [83]:
bools1 3
[[False,False,False],[False,False,True],[False,True,False],[False,True,True],[True,False,False],[True,False,True],[True,True,False],[True,True,True]]
In [85]:
-- A simpler and recursive definition of bools
bools :: Int -> [[Bool]]
bools 0 = [[]]
bools n = map (False:) bss ++ map (True:) bss
  where bss = bools (n-1)
In [86]:
bools 3
[[False,False,False],[False,False,True],[False,True,False],[False,True,True],[True,False,False],[True,False,True],[True,True,False],[True,True,True]]
In [88]:
-- now we generate all possible substitions for variables
rmdups :: Eq a => [a] -> [a]
rmdups [] = []
rmdups (x:xs) = x : filter (/= x) (rmdups xs)

substs :: Prop -> [Subst]
substs p = map (zip vs) (bools (length vs))
  where vs = rmdups (vars p)
In [89]:
substs p1
[[('A',False)],[('A',True)]]
In [90]:
substs p2
[[('A',False),('B',False)],[('A',False),('B',True)],[('A',True),('B',False)],[('A',True),('B',True)]]

Step 4: Test tautology

In [93]:
isTaut :: Prop -> Bool
isTaut p = and [eval s p | s <- substs p]
In [94]:
isTaut p1
isTaut p2
isTaut p3
isTaut p4
False
True
False
True

8.7 Abstract Machine

In [1]:
data Expr = Val Int | Add Expr Expr

value :: Expr -> Int
value (Val n)   = n
value (Add x y) = value x + value y
In [9]:
e1 = Add (Add (Val 2) (Val 3)) (Val 4)
value e1
9
  value (Add (Add (Val 2) (Val 3)) (Val 4))
= value (Add (Val 2) (Val 3)) + value (Val 4)
= value (Val 2) + value (Val 3) + value (Val 4)
= (2 + value (Val 3)) + value (Val 4)
= (2 + 3) + value (Val 4)
= 5 + value (Val 4)
= 5 + 4
= 9

Note that the definition of value does not specify the order of operations; So, Haskell selects its own order; in this case left to right.

We introduce a method that uses a control stack containing operations that introduce a particular order of operation.

In [10]:
type Cont = [Op]
data Op = EVAL Expr | ADD Int
In [11]:
eval :: Expr -> Cont -> Int
eval (Val n) c   = exec c n
eval (Add x y) c = eval x (EVAL y : c)

exec :: Cont -> Int -> Int
exec [] n           = n
exec (EVAL y : c) n = eval y (ADD n : c)
exec (ADD n : c)  m = exec c (n + m)

value1 :: Expr -> Int
value1 e = eval e []
In [12]:
value1 e1
9
  value1 (Add (Add (Val 2) (Val 3)) (Val 4))
= eval (Add (Add (Val 2) (Val 3)) (Val 4)) []
= eval (Add (Val 2) (Val 3)) [EVAL (Val 4)]
= eval (Val 2) [EVAL (Val 3), EVAL (Val 4)]
= exec [EVAL (Val 3), EVAL (Val 4)] 2
= eval (Val 3) [ADD 2, EVAL (Val 4)]
= exec [ADD 2, EVAL (Val 4)] 3
= exec [EVAL (Val 4)] 5
= eval (Val 4) [ADD 5]
= exec [ADD 5] 4
= exec [] 9
= 9