Попытка применить CPS к интерпретатору

Я пытаюсь использовать CPS для упрощения реализации потока управления в моем интерпретаторе Python. В частности, при реализации return/break/continue я должен сохранять состояние и разматывать вручную, что является утомительным. Я читал, что это чрезвычайно сложно реализовать обработку исключений. Я хочу, чтобы каждая функция eval имела возможность направлять поток управления либо на следующую команду, либо на другую команду целиком.

Некоторые люди с большим опытом, чем я, предложили изучить CPS как способ справиться с этим должным образом. Мне очень нравится, как это упрощает поток управления в интерпретаторе, но я не уверен, сколько мне нужно сделать для этого.

Я думаю, что я вообще понимаю трансформацию CPS: цель состоит в том, чтобы пронизывать продолжение через весь АСТ, включая все выражения.

Я также немного смущен, где монада Cont подходит здесь, так как язык хоста - Haskell.

Изменить: здесь приведена сжатая версия AST. Это 1-1-отображение операторов, выражений и встроенных значений Python.

Все, что мотивировало все это, - это махинации, необходимые для осуществления перерыва. Определение разрыва разумно, но то, что он делает с определением while, немного:

Я уверен, что здесь можно сделать больше упрощений, но основная проблема заключается в том, что где-то заполняется, и вручную завершается. Я надеюсь, что CPS позволит мне вести бухгалтерский учет (например, точки выхода цикла) в состояние и просто использовать те, когда они мне нужны.

Мне не нравится разделение между выражениями и выражениями и беспокоиться, что это может сделать преобразование CPS более эффективным.

Ответы

Ответ 1

Это, наконец, дало мне хороший повод попробовать использовать ContT!

Вот один из возможных способов сделать это: сохранить (в Reader завернутый в 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