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 Loc | UNMARK | LABEL Loc | JUMP Loc deriving Show type Loc = Int fresh :: Loc -> Loc fresh a = a+1 comp :: Loc -> Expr -> Code comp a e = fst (compile a e) compile :: Loc -> Expr -> (Code,Loc) compile a (Val n) = ([PUSH n], a) compile a (Add x y) = (xs ++ ys ++ [ADD], c) where (xs,b) = compile a x (ys,c) = compile b y compile a (Throw) = ([THROW], a) compile a (Catch x h) = ([MARK a] ++ xs ++ [UNMARK, JUMP b, LABEL a] ++ hs ++ [LABEL b], e) where b = fresh a c = fresh b (xs,d) = compile c x (hs,e) = compile d h ----------------------------------------------------------------------------- -- Virtual machine ----------------------------------------------------------------------------- type Stack = [Item] data Item = VAL Int | HAN Loc 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 ops exec s (MARK a : ops) = exec (HAN a : s) ops exec s (UNMARK : ops) = case s of (x : HAN _ : s') -> exec (x:s') ops exec s (LABEL _ : ops) = exec s ops exec s (JUMP a : ops) = exec s (jump a ops) unwind :: Stack -> Code -> Stack unwind [] _ = [] unwind (VAL _ : s) ops = unwind s ops unwind (HAN a : s) ops = exec s (jump a ops) jump :: Loc -> Code -> Code jump _ [] = [] jump a (LABEL b : ops) = if a == b then ops else jump a ops jump a (_ : ops) = jump a ops -----------------------------------------------------------------------------