Haskell Monad（下）

Posted 2021-04-25 牛顿一号

Haskell中的Monad（下）

这里先放上篇中关于eval的monad实现代码，在ghc 8.2.2中验证通过。

上篇相关代码实现

basic monadic eval

 1{- basic eval -}
 2data Term = Con Int | Div Term Term
 3{-Monadic Evaluation Function -}
 4type M a = a
 5unit :: a -> M a
 6unit = id
 7(>>>) :: M a -> (a -> M b) -> M b
 8a >>> k = k a
 9eval :: Term -> M Int
10eval (Con a) = unit a
11eval (Div t u) = eval t >>> \x -> eval u >>> \y -> unit (round (fromIntegral x/ fromIntegral y))
12

带异常处理的monadic eval。

 1{- Monadic Eval with Exception Handling -}
 2data Term = Con Int | Div Term Term
 3data M a = Raise Exception | Return a deriving (Show)
 4type Exception = String
 5unit :: a -> M a
 6unit a = Return a
 7(>>>) :: M a -> (a -> M b) -> M b
 8m >>> k = case m of
 9  Raise e -> Raise e
10  Return a -> k a
11raise :: Exception -> M a
12raise e = Raise e
13eval :: Term -> M Int
14eval (Con a) = unit a
15eval (Div t u) = eval t >>> \x -> eval u >>> \y -> if y == 0
16  then raise "divide by zero"
17  else unit (round (fromIntegral x/ fromIntegral y))

带状态的monadic eval

 1{- Monadic Eval with State Handling -}
 2data Term = Con Int | Div Term Term
 3type M a = State -> (a, State)
 4type State = Int
 5unit :: a -> M a
 6unit a = \x -> (a, x)
 7(>>>) :: M a -> (a -> M b) -> M b
 8m >>> k = \x -> let (a,y) = m x in
 9                let (b,z) = k a y in (b,z)
10tick :: M ()
11tick = \x -> ((), x+1)
12eval :: Term -> M Int
13eval (Con a) = unit a
14eval (Div t u) = eval t >>> \x -> eval u >>> \y -> tick >>> \_ -> unit(round (fromIntegral x/ fromIntegral y))

带状态的monadic eval运行结果。

1*Main> eval (Div (Con 10) (Div (Con 4) (Con 2))) 0
2*Main> (5,2)

带trace功能的monadic eval。

 1{- Monadic Eval with Tracing -}
 2data Term = Con Int | Div Term Term deriving (Show)
 3type M a = (Output,a)
 4type Output = String
 5unit :: a -> M a
 6unit a = ("", a)
 7(>>>) :: M a -> (a -> M b) -> M b
 8m >>> k = let (x,a) = m in
 9          let (y,b) = k a in
10          (y++x, b)
11out :: Output -> M ()
12out x = (x,())
13eval :: Term -> M Int
14eval (Con a) = out (show (Con a)) >>> \_ -> unit(a)
15eval (Div t u) = eval t >>> \x -> eval u >>> \y -> out (show (Div t u)) >>> \_ -> unit(round (fromIntegral x/ fromIntegral y))

output monad运行结果。

1*Main> eval (Con 2)
2("Con 2",2)
3*Main> eval (Div (Con 10) (Con 5))
4("Con 10Con 5Div (Con 10) (Con 5)",2)
5#x++y -> y++x后
6*Main> eval (Div (Con 10) (Con 5))
7("Div (Con 10) (Con 5)Con 5Con 10",2)
8*Main>