Graham Hutton 的 ccc 出了第三版 http://www.cs.nott.ac.uk/~pszgmh/bib.html
照例复制，并运行一番。
module Main where
import Prelude hiding ((>>=), return)
data Expr = Val Int | Add Expr Expr | Throw | Catch Expr Expr | Block Expr | Unblock Expr
data ND a = E | Ret a | ND a :||: ND a
g :: Show a => ND a -> String
g E = "E"
g (Ret x) = "RET" ++ show x
g ( x :||: y) = (g x) ++ ":||:" ++ (g y)
return :: a -> ND a
return x = Ret x
reduce :: ND a -> ND a
reduce E = E
reduce (Ret x) = Ret x
reduce ( x :||: E) = reduce x
reduce ( x :||: y) = (reduce x :||: y)
(>>=) :: ND a -> (a -> ND b) -> ND b
E >>== f = E
(Ret x) >>= f = f x
( x :||: y) >>= f = (x >>= f) :||: ( y >>= f )
data Code = HALT | PUSH Int Code | ADD Code | THROW | MARK Code Code | UNMARK Code | BLOCK Code | UNBLOCK Code | RESET Code deriving Show
compile :: Expr -> Code
compile e = comp e HALT
comp :: Expr -> Code -> Code
comp (Val n) c = PUSH n c
comp(Add x y) c=comp x (comp y(ADD c))
comp Throw c = THROW
comp (Catch x y) c = MARK (comp y c) (comp x (UNMARK c))
comp (Block x) c = BLOCK (comp x (RESET c))
comp (Unblock x) c = UNBLOCK (comp x (RESET c))
type Conf = (Stack, Status)
type Stack = [Elem]
data Elem = VAL Int | HAN Code | STA Status deriving Show
data Status = B | U deriving Show
exec :: Code -> Conf -> ND Conf
exec HALT (s, i) = return (s, i)
exec (PUSH n c) (s, i) = exec c (VAL n:s, i) :||: inter s i
exec (ADD c) (VAL n : VAL m : s, i) = exec c (VAL (m + n):s, i) :||: inter s i
exec THROW (s, i) = fail' s i
exec (MARK c1 c) (s, i) = exec c (HAN c1: s, i) :||: inter s i
exec (UNMARK c)(VAL n : HAN _:s, i) = exec c (VAL n:s,i)
exec (BLOCK c) (s, i) = exec c (STA i : s, B)
exec (UNBLOCK c) (s, i) = exec c (STA i : s, U)
exec (RESET c)(VAL v: STA i:s, _) = exec c (VAL v:s,i) :||: inter s i
exec _ _ = E
inter :: Stack -> Status -> ND Conf
inter s B = E
inter s U = fail' s U
fail' :: Stack -> Status -> ND Conf
fail'(VAL m:s) i = fail' s i
fail' (HAN c:s) i = exec c (s,i)
fail' (STA i:s) _ = fail' s i
fail' _ _ = E
main :: IO()
main =
print (g (reduce (exec (compile ( Unblock (Add (Val 3) (Unblock (Catch Throw (Val 4)))))) ([] , B))))
Haskell 的基础还是很薄弱。体现在两个上问题：
1. data ND a = ∅ | Ret a | ND a ⊕ ND a 怎么弄。我用的 Haskell for Mac 不行。
2. (>>=) 去掉之后完全不影响程序。放到这里有什么用？