--
{- From the prelude, so we can't redefine
class Eq a where
 (==), (/=) :: a -> a -> Bool
 x /= y = not (x==y)
class (Eq a) => Ord a where
 compare :: a -> a -> Ordering
 (<), (<=), (>=), (>) :: a -> a -> Bool
 max, min :: a -> a -> a
-}
-------- Equality over Arithmetic Expressions
data Aop = Add | Sub | Mult | Div
data Aexp = Num Int | Exp (Aexp, Aop, Aexp)
int_eq :: Int -> Int -> Bool
int_eq x y = x==y
aop_eq Add Add = True
aop_eq Sub Sub = True
aop_eq Mult Mult = True
aop_eq Div Div = True
aop_eq _ _ = False
aexp_eq (Num x) (Num y) = int_eq x y
aexp_eq (Exp(e1,x,e2))(Exp(f1,y,f2))
 = (aexp_eq e1 f1) &&
 (aop_eq x y) &&
 (aexp_eq e2 f2)
aexp_eq _ _ = False
instance Eq(Aop) where
 x == y = aop_eq x y
 x /= y = not(aop_eq x y )
instance Eq(Aexp) where
 x == y = aexp_eq x y
 x /= y = not(aexp_eq x y )
------The Complex Example
data Complex = C Float Float
complex_add (C x y) (C a b) = C (x+a) (y+b)
complex_sub (C x y) (C a b) = C (x-a) (y-b)
complex_mult (C x y) (C a b)
 = C (x*a - y*b) (x*b + a*y)
instance Eq(Complex) where
 (C x y) == (C a b) = x==a && y==b
instance Show(Complex) where
 showsPrec = error "No show for complex"
 showList = error "No show for complex"
instance Num(Complex) where
 x + y = complex_add x y
 x - y = complex_sub x y
 x * y = complex_mult x y
 {- The full Num class from the prelude so it can't be redefined. Use comment
 class (Eq a, Show a) => Num a where
 (+), (-), (*) :: a -> a -> a
 negate :: a -> a
 abs, signum :: a -> a
 fromInteger :: Integer -> a
 fromInt :: Int -> a
 x - y = x + negate y
 fromInt = fromIntegral
-}
---------- Ordering of trees
data Tree a = Leaf a | Branch (Tree a) (Tree a)
instance Eq a => Eq (Tree a) where
 (Leaf x) == (Leaf y) = x==y
 (Branch x y) == (Branch a b) = x==a && y==b
 _ == _ = False
instance (Ord a,Eq a) => Ord(Tree a) where
 (Leaf _) < (Branch _ _) = True (Leaf x) < (Leaf y) = x < y (Branch _ _) < (Leaf _) = False (Branch l1 r1) < (Branch l2 r2) = if l1==l2 then r1 < r2 else l1 < l2 t1 <= t2 = t1 < t2 || t1 == t2 -------- Classes for type constuctors - Motivation data Mylist a = Nil | Cons a (Mylist a) int_list_eq(Nil, Nil) = True int_list_eq(Cons x xs, Cons y ys) = (int_eq x y) && (int_list_eq(xs,ys)) int_list_eq (_, _) = False list_eq :: (a -> b -> Bool) -> (Mylist a,Mylist b) -> Bool
list_eq f (Nil, Nil) = True
list_eq f (Cons x xs, Cons y ys) =
 (f x y) && (list_eq f (xs, ys))
list_eq f (_, _) = False
instance Eq a => Eq(Mylist a) where
 Nil == Nil = True
 (Cons x xs) == (Cons y ys) = (x == y) && (xs == ys)
 _ == _ = False
--------------- The Bush type. Soemthing to think about
data Bush a = One a
 | Two (Bush a) (Bush a)
 | Many [Bush a]
instance (Eq a) => Eq(Bush a) where
 (One x) == (One y) = (x == y)
 (Two x1 x2) == (Two y1 y2) = (x1 == y1) && (x2 == y2)
 (Many xs) == (Many ys) = (xs == ys)
 _ == _ = False
------ The class MyShow a simplification of the Class Shoe
class MyShow a where
 myshow :: a -> String
 myshows :: a -> String -> String
name = "Tim"
age = 9
test = "My name is" ++ show name ++ "I am" ++ show age ++ "years old"
instance MyShow a => MyShow (Tree a) where
 myshow (Leaf x) = "(Leaf " ++ myshow x ++ ")"
 myshow (Branch x y) =
 "(Branch" ++ myshow x ++ myshow y ++ ")"
showsTree :: MyShow a => Tree a -> String -> String
showsTree (Leaf x) s = "(Leaf " ++ myshow x ++ ")" ++ s
showsTree (Branch x y) s =
 "(Branch" ++ (showsTree x (showsTree y (")" ++ s)))
showsList [] s = s
showsList (x:xs) s = shows x (showsList xs s)
-------- Derived Instances
data Color = Red | Orange | Yellow | Green
 | Blue |Indigo | Violet
 deriving Show
data Exp = Int Int | Plus Exp Exp | Minus Exp Exp
 deriving (Eq,Show)
-------- Propogating qualified types
member x [] = False
member x (z:zs) =
 if x==z then True else member x zs
-- 

AltStyle によって変換されたページ (->オリジナル) /