programming haskell 10章の問題をちょっとやってみたのの残骸

10.hs

-- 10.5

data Expr = Val Int | Add Expr Expr

value :: Expr -> Int
value (Val n) = n
value (Add x y) = value x + value y

type Cont = [Op]
data Op = EVAL Expr | ADD Int

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)

class Test a where
  test :: a -> a -> [a]
  -- test x y = [x,y]

instance Test Int where
  test x y = [x,y,1]


-- ex 10.8 -1 
data Natural = Zero | Succeed Natural
               deriving(Show)

natural2int :: Natural -> Int
natural2int Zero = 0
natural2int (Succeed n) = 1 + natural2int n

int2natural :: Int -> Natural
int2natural 0 = Zero
int2natural n = Succeed $ int2natural (n - 1)

addNatural :: Natural -> Natural -> Natural
addNatural x Zero = x
addNatural x (Succeed n) = addNatural (Succeed x) n


multiplyNatural :: Natural -> Natural -> Natural
multiplyNatural Zero _ = Zero
multiplyNatural _ Zero = Zero
multiplyNatural (Succeed Zero) y = y
multiplyNatural x (Succeed Zero) = x
multiplyNatural x y = loopAddNatural y
  where
    loopAddNatural (Succeed Zero) = x
    loopAddNatural (Succeed n) = addNatural x $ loopAddNatural n

-- ex 10.8 - 2

data Ord a => BSTree a = Nil | Node (BSTree a) a (BSTree a)
                       deriving(Show)

insert :: Ord a => a -> BSTree a -> BSTree a
insert x Nil = Node Nil x Nil
insert x t@(Node left y right) = case compare x y of
                                  LT -> Node (insert x left) y right
                                  GT -> Node left y (insert x right)
                                  EQ -> t

occur :: Ord a => a -> BSTree a -> Bool
occur x Nil = False
occur x (Node left y right) = case compare x y of
                                LT -> occur x left
                                GT -> occur x right
                                EQ -> True

-- ex 10.8 - 8

data MyMaybe a = MyNothing | MyJust a
  deriving (Eq, Ord, Show)

instance Monad MyMaybe where
  -- return :: a -> MyMaybe a
  return = MyJust
  -- (>>=) :: MyMaybe a -> (a -> MyMaybe b) -> MyMaybe b
  (MyJust x) >>= k = k x
  MyNothing  >>= _ = MyNothing
  
instance Monad [] where
  -- return :: a -> [a]
  return x = [x]
  -- (>>=) :: [a] -> (a -> [b]) -> [b]
  [] >>= _  = []
  xs >>= f  = map f xs