haskell - Trying to apply CPS to an interpreter -

i'm trying use cps simplify control-flow implementation in python interpreter. specifically, when implementing return/break/continue, have store state , unwind manually, tedious. i've read it's extraordinarily tricky implement exception handling in way. want each eval function able direct control flow either next instruction, or different instruction entirely.

some people more experience me suggested looking cps way deal properly. how simplifies control flow in interpreter, i'm not sure how need in order accomplish this.

1. do need run cps transform on ast? should lower ast lower-level ir smaller , transform that?

2. do need update evaluator accept success continuation everywhere? (i'm assuming so).

i think understand cps transform: goal thread continuation through entire ast, including expressions.

i'm bit confused cont monad fits in here, host language haskell.

edit: here's condensed version of ast in question. 1-1 mapping of python statements, expressions, , built-in values.

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 

to evaluate statements, use eval:

eval (assignment (variable var) expr) =     value <- evalexpr expr     updatesymbol var value  eval (expression e) =     _ <- evalexpr e     return () 

to evaluate expressions, use evalexpr:

evalexpr (attribute target name) =     receiver <- evalexpr target     attribute <- getattr name receiver     case attribute of         v  -> return v         nothing -> fail $ "no attribute " ++ name  evalexpr (constant c) = return c 

what motivated whole thing shenanigans required implementing break. break definition reasonable, while definition bit much:

eval (break) =     env <-     when (looplevel env <= 0) (fail "can break in loop!")     put env { flow = breaking }  eval (while condition block) =     setup     loop     cleanup              setup =             env <-             let level = looplevel env             put env { looplevel = level + 1 }          loop =             env <-             result <- evalexpr condition             when (istruthy result && flow env == next) $                 evalblock block                  -- pretty ugly! eat continue.                 updatedenv <-                 when (flow updatedenv == continuing) $ put updatedenv { flow = next }                  loop          cleanup =             env <-             let level = looplevel env             put env { looplevel = level - 1 }              case flow env of                 breaking    -> put env { flow = next }                 continuing  -> put env { flow = next }                 _           -> return () 

i sure there more simplifications can done here, core problem 1 of stuffing state somewhere , manually winding out. i'm hoping cps let me stuff book-keeping (like loop exit points) state , use when need them.

i dislike split between statements , expressions , worry might make cps transform more work.

this gave me excuse try using contt!

here's 1 possible way of doing this: store (in reader wrapped in contt) continuation of exiting current (innermost) loop:

newtype m r = m{ unm :: contt r (readert (m r ()) (statet (map id value) io)) }               deriving ( functor, applicative, monad                        , monadreader (m r ()), monadcont, monadstate (map id value)                        , monadio                        )  runm :: m a -> io runm m = evalstatet (runreadert (runcontt (unm m) return) (error "not in loop")) m.empty  withbreakhere :: m r () -> m r () withbreakhere act = callcc $ \break -> local (const $ break ()) act  break :: m r () break = join ask 

(i've added io easy printing in toy interpreter, , state (map id value) variables).

using setup, can write break , while as:

eval break = break eval (while condition block) = withbreakhere $ fix $ \loop ->     result <- evalexpr condition     unless (istruthy result)       break     evalblock block     loop 

here's full code reference:

{-# language generalizednewtypederiving #-} module interp  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 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 = m{ unm :: contt r (readert (m r ()) (statet (map id value) io)) }               deriving ( functor, applicative, monad                        , monadreader (m r ()), monadcont, monadstate (map id value)                        , monadio                        )  runm :: m a -> io runm m = evalstatet (runreadert (runcontt (unm m) return) (error "not in 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       err = error $ unwords ["variable not in scope:", show v] evalexpr (add e1 e2) =     int val1 <- evalexpr e1     int val2 <- evalexpr e2     return $ int $ val1 + val2 evalexpr (not e) =     val <- evalexpr e     return $ if istruthy val 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) =     val <- evalexpr e     modify $ m.insert v val eval (print e) =     val <- evalexpr e     liftio $ print val eval (if cond block) =     val <- evalexpr cond     when (istruthy val) $       evalblock block eval break = break eval (while condition block) = withbreakhere $ fix $ \loop ->     result <- evalexpr condition     unless (istruthy result)       break     evalblock block     loop 

and here's neat test example:

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

which is

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

so print

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