Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
----------------------------------------------------------------------------- -- -- Compiling Exceptions Correctly -- -- Graham Hutton and Joel Wright -- University of Nottingham -- -- February 2005 -- ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- Expressions ----------------------------------------------------------------------------- data Expr = Val Int | Add Expr Expr | Throw | Catch Expr Expr deriving Show eval :: Expr -> Maybe Int eval (Val n) = Just n eval (Add x y) = case eval x of Nothing -> Nothing Just n -> case eval y of Nothing -> Nothing Just m -> Just (n+m) eval (Throw) = Nothing eval (Catch x h) = case eval x of Nothing -> eval h Just n -> Just n ----------------------------------------------------------------------------- -- Compiler ----------------------------------------------------------------------------- type Code = [Op] data Op = PUSH Int | ADD | THROW | MARK Code | UNMARK deriving Show comp :: Expr -> Code comp (Val n) = [PUSH n] comp (Add x y) = comp x ++ comp y ++ [ADD] comp (Throw) = [THROW] comp (Catch x h) = [MARK (comp h)] ++ comp x ++ [UNMARK] ----------------------------------------------------------------------------- -- Virtual machine ----------------------------------------------------------------------------- type Stack = [Item] data Item = VAL Int | HAN Code deriving Show exec :: Stack -> Code -> Stack exec s [] = s exec s (PUSH n : ops) = exec (VAL n : s) ops exec s (ADD : ops) = case s of (VAL m : VAL n : s') -> exec (VAL (n+m) : s') ops exec s (THROW : ops) = unwind s (skip ops) exec s (MARK ops' : ops) = exec (HAN ops' : s) ops exec s (UNMARK : ops) = case s of (x : HAN _ : s') -> exec (x:s') ops unwind :: Stack -> Code -> Stack unwind [] _ = [] unwind (VAL _ : s) ops = unwind s ops unwind (HAN ops' : s) ops = exec s (ops' ++ ops) skip :: Code -> Code skip [] = [] skip (UNMARK : ops) = ops skip (MARK _ : ops) = skip (skip ops) skip (_ : ops) = skip ops -----------------------------------------------------------------------------