gistfile1.hs

{-# LANGUAGE OverloadedStrings, GADTs #-}

import Prelude
import Control.Monad.Operational

data StackInstruction a where
  Push :: Int -> StackInstruction ()
  Pop  :: StackInstruction Int

type StackProgram a = Program StackInstruction a
type Stack b        = [b]

push = singleton . Push
pop = singleton Pop

interpret :: StackProgram a -> (Stack Int -> a)
interpret = eval . view
  where
    eval :: ProgramView StackInstruction a -> (Stack Int -> a)
    eval (Push a :>>= is) stack     = interpret (is ()) (a:stack)
    eval (Pop    :>>= is) (a:stack) = interpret (is a ) stack
    eval (Return a)       stack     = a

main = print $ interpret prog [7,11]
  where prog = do
                a <- pop
                b <- pop
                return (a*b)