PROSAGA码农传奇-XOS-尝试将CPS应用于口译员

<div class =“post-text”itemprop =“text”>
  
    这最终给了我一个尝试使用的好借口
     <code>
 ContT
 </code>
    ！
  
  
    这是一种可行的方法：存储（在
     <code>
 Reader
 </code>
     包装成
     <code>
 ContT
 </code>
    ）退出当前（最内层）循环的继续：
  
   <pre>
 <code>
 newtype M r a = M{ unM :: ContT r (ReaderT (M r ()) (StateT (Map Id Value) IO)) a }
 deriving ( Functor, Applicative, Monad
 , MonadReader (M r ()), MonadCont, MonadState (Map Id Value)
 , MonadIO
 )

runM :: M a a -> IO a
runM m = evalStateT (runReaderT (runContT (unM m) return) (error "not in a loop")) M.empty

withBreakHere :: M r () -> M r ()
withBreakHere act = callCC $ \break -> local (const $ break ()) act

break :: M r ()
break = join ask

</code>
 </pre>
  
    （我也补充说
     <code>
 IO
 </code>
     在我的玩具翻译中轻松打印，以及
     <code>
 State (Map Id Value)
 </code>
     对于变量）。
  
  
    使用此设置，您可以编写
     <code>
 Break
 </code>
     和
     <code>
 While
 </code>
     如：
  
   <pre>
 <code>
 eval Break = break
eval (While condition block) = withBreakHere $ fix $ \loop -> do
 result <- evalExpr condition
 unless (isTruthy result)
 break
 evalBlock block
 loop

</code>
 </pre>
  
    以下是完整的参考代码：
  
   <pre>
 <code>
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Interp where

import Prelude hiding (break)
import Control.Applicative
import Control.Monad.Cont
import Control.Monad.State
import Control.Monad.Reader
import Data.Function
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe

type Id = String

data Statement
    = Print Expression
    | Assign Id Expression
    | Break
    | While Expression [Statement]
    | If Expression [Statement]
    deriving Show

data Expression
    = Var Id
    | Constant Value
    | Add Expression Expression
    | Not Expression
    deriving Show

data Value
    = String String
    | Int Integer
    | None
    deriving Show

data Env = Env{ loopLevel :: Int
              , flow :: Flow
              }

data Flow
    = Breaking
    | Continuing
    | Next
    deriving Eq

newtype M r a = M{ unM :: ContT r (ReaderT (M r ()) (StateT (Map Id Value) IO)) a }
              deriving ( Functor, Applicative, Monad
                       , MonadReader (M r ()), MonadCont, MonadState (Map Id Value)
                       , MonadIO
                       )

runM :: M a a -> IO a
runM m = evalStateT (runReaderT (runContT (unM m) return) (error "not in a loop")) M.empty

withBreakHere :: M r () -> M r ()
withBreakHere act = callCC $ \break -> local (const $ break ()) act

break :: M r ()
break = join ask

evalExpr :: Expression -> M r Value
evalExpr (Constant val) = return val
evalExpr (Var v) = gets $ fromMaybe err . M.lookup v
 where
 err = error $ unwords ["Variable not in scope:", show v]
evalExpr (Add e1 e2) = do
 Int val1 <- evalExpr e1
 Int val2 <- evalExpr e2
 return $ Int $ val1 + val2
evalExpr (Not e) = do
 val <- evalExpr e
 return $ if isTruthy val then None else Int 1

isTruthy (String s) = not $ null s
isTruthy (Int n) = n /= 0
isTruthy None = False

evalBlock = mapM_ eval

eval :: Statement -> M r ()
eval (Assign v e) = do
 val <- evalExpr e
 modify $ M.insert v val
eval (Print e) = do
 val <- evalExpr e
 liftIO $ print val
eval (If cond block) = do
 val <- evalExpr cond
 when (isTruthy val) $
 evalBlock block
eval Break = break
eval (While condition block) = withBreakHere $ fix $ \loop -> do
 result <- evalExpr condition
 unless (isTruthy result)
 break
 evalBlock block
 loop

</code>
 </pre>
  
    这是一个简洁的测试示例：
  
   <pre>
 <code>
 prog = [ Assign "i" $ Constant $ Int 10
 , While (Var "i") [ Print (Var "i")
 , Assign "i" (Add (Var "i") (Constant $ Int (-1)))
 , Assign "j" $ Constant $ Int 10
 , While (Var "j") [ Print (Var "j")
 , Assign "j" (Add (Var "j") (Constant $ Int (-1)))
 , If (Not (Add (Var "j") (Constant $ Int (-4)))) [ Break ]
 ]
 ]
 , Print $ Constant $ String "Done"
 ]

</code>
 </pre>
  
    是的
  
   <pre>
 <code>
 i = 10
while i:
 print i
 i = i - 1
 j = 10
 while j:
 print j
 j = j - 1
 if j == 4:
 break

</code>
 </pre>
  
    所以它会打印出来
  
   <pre>
 <code>
 10 10 9 8 7 6 5
 9 10 9 8 7 6 5
 8 10 9 8 7 6 5
...
 1 10 9 8 7 6 5

</code>
 </pre>
</DIV>