12

CPS を使用して、Python インタープリターでの制御フローの実装を簡素化しようとしています。具体的には、return/ break/continueを実装するときは、状態を保存して手動で巻き戻す必要があり、面倒です。この方法で例外処理を実装するのは非常に難しいと読んだことがあります。私が望むのは、各eval関数が制御フローを次の命令または別の命令に完全に向けることができるようにすることです。

私よりも経験豊富な何人かは、これを適切に処理する方法として CPS を調べることを提案しました。インタープリターでの制御フローを単純化する方法は本当に気に入っていますが、これを達成するために実際にどれだけの作業を行う必要があるかはわかりません。

  1. AST で CPS 変換を実行する必要がありますか? この AST をより小さな下位レベルの IR に下げてから、それを変換する必要がありますか?

  2. どこでも成功の継続を受け入れるようにエバリュエーターを更新する必要がありますか? （私はそう仮定しています）。

私は、CPS 変換を一般的に理解していると思います。目標は、すべての式を含む AST 全体を通して継続をスレッド化することです。

Contまた、ホスト言語が Haskell であるため、モナドがどこに収まるかについても少し混乱しています。

編集: 問題の AST の要約版を次に示します。これは、Python ステートメント、式、および組み込み値の 1 対 1 のマッピングです。

data Statement
    = Assignment Expression Expression
    | Expression Expression
    | Break
    | While Expression [Statement]

data Expression
    | Attribute Expression String
    | Constant Value

data Value
    = String String
    | Int Integer
    | None

ステートメントを評価するには、次を使用しますeval。

eval (Assignment (Variable var) expr) = do
    value <- evalExpr expr
    updateSymbol var value

eval (Expression e) = do
    _ <- evalExpr e
    return ()

式を評価するには、次を使用しますevalExpr。

evalExpr (Attribute target name) = do
    receiver <- evalExpr target
    attribute <- getAttr name receiver
    case attribute of
        Just v  -> return v
        Nothing -> fail $ "No attribute " ++ name

evalExpr (Constant c) = return c

全体の動機となったのは、休憩を実装するために必要な悪ふざけでした。break の定義は合理的ですが、while の定義に対して行うことは少し多すぎます。

eval (Break) = do
    env <- get
    when (loopLevel env <= 0) (fail "Can only break in a loop!")
    put env { flow = Breaking }

eval (While condition block) = do
    setup
    loop
    cleanup

    where
        setup = do
            env <- get
            let level = loopLevel env
            put env { loopLevel = level + 1 }

        loop = do
            env <- get
            result <- evalExpr condition
            when (isTruthy result && flow env == Next) $ do
                evalBlock block

                -- Pretty ugly! Eat continue.
                updatedEnv <- get
                when (flow updatedEnv == Continuing) $ put updatedEnv { flow = Next }

                loop

        cleanup = do
            env <- get
            let level = loopLevel env
            put env { loopLevel = level - 1 }

            case flow env of
                Breaking    -> put env { flow = Next }
                Continuing  -> put env { flow = Next }
                _           -> return ()

ここで実行できる単純化は他にもあると確信していますが、核となる問題は、状態をどこかに詰め込み、手動で巻き戻すことです。CPS によって簿記 (ループ出口ポイントなど) を状態に詰め込み、必要なときにそれらを使用できるようになることを願っています。

私はステートメントと式が分かれているのが嫌いで、CPS 変換の作業が増えるのではないかと心配しています。

4

1 に答える 1

10

これにより、ContT!

これを行う1つの可能な方法は次のとおりです。現在の（最も内側の）ループを終了する続きを（Readerラップされた in に）保存します。ContT

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

IO（おもちゃのインタープリターで簡単に印刷するため、およびState (Map Id Value)変数用にも追加しました）。

このセットアップを使用するBreakと、次のように書くことができますWhile。

eval Break = break
eval (While condition block) = withBreakHere $ fix $ \loop -> do
    result <- evalExpr condition
    unless (isTruthy result)
      break
    evalBlock block
    loop

参照用の完全なコードは次のとおりです。

{-# 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

そして、ここにきちんとしたテストの例があります:

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"
       ]

これは

i = 10
while i:
  print i
  i = i - 1
  j = 10
  while j:
    print j
    j = j - 1
    if j == 4:
      break

だからそれは印刷されます

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
于 2014-08-19T11:33:03.490 に答える