Yesterday someone posted a link to a great monad transformers tutorial. It's incredible. I think I finally start to understand (or at least being able to use) it.
As part of testing my fresh knowledge I've written a simple virtual machine for a Forth-like language. Code (as usual - Literate Haskell, so you can just put it into .lhs file and run it) below.
Enjoy!
Data type
> module Main where
>
> import Control.Monad.State
> import Control.Monad.Reader
> import Data.Char
> import Data.Maybe
> import System.IO
>
> import qualified Data.Map as Map
Op defines all primitive operations available in our language.
> data Op =
> Number Int -- push number on stack
> | Plus -- add two elements on top of stack
> | Minus -- subtract
> | Mul -- multiplicate
> | Div -- divide
> | Out -- write single number from stack to stdout
> | Emit -- emit character with code from stack to stdout
> | Dup -- duplicate item on top of stack
> | Drop -- drop top-most item
> | Call String -- call function with given name
> | GetI -- get current loop counter and push on stack
> | Loop [Op] -- execute loop body; max and min must be on stack
> | If [Op] [Op] -- if statement with "then" and "else" block
> | Equal -- push 1 if top-most items are equal, 0 otherwise
> | Less -- push 1 if top-most item is greater than item below it
> | Greater -- push 1 if top-most item is smaller than item below it
> deriving Show
Words is a dictionary mapping function names to their code.
> type Words = Map.Map String [Op]
ForthState contains current interpreter state. It consists of data stack and of loop counter. Currently no nested loops are supported.Interpreter state is defined using two monad transformers -
> data ForthState = ForthState {
> stack :: [Int],
> counter :: Int
> } deriving Show
StateT responsible for state management (stack, counter), and ReaderT providing read-only environment, in this case dictionary of user-defined words. IO is used as internal monad since program is supposed to perform I/O operations.Computation does not return any useful results, hence return type of whole computation is
().
> type Forth = ReaderT Words (StateT ForthState IO) ()
>
> initState = ForthState [] 0
runForth function performs execution of given program in given environment (defined words) starting from given state.Execution of sequence of operations is realized by simple (monadic) mapping of
> runForth :: Words -> ForthState -> [Op] -> IO ((), ForthState)
> runForth env st program = runStateT (runReaderT (execSequence program) env) st
exec function which interprets single operation over whole program. Mapping variant used ignores return values of subsequent exec invocations since it does not return any useful data anyway.Utility functions for stack operations.
> execSequence program = mapM_ exec program
And
> push n = do state <- get
> put $ state { stack = n:(stack state) }
>
> pop = do state <- get
> case stack state of
> (x:xs) -> do put $ state { stack = xs }
> return x
exec implementation for different operations.Time for a sample program to be executed. Program will calculate factorials of numbers from 1 to 7 and output them as lines with pairs number - factorial.
> -- ( -- n )
> exec (Number n) = push n
>
> -- ( n -- )
> exec Drop = pop >> return () -- pop and ignore returned value
>
> -- ( n -- n n )
> exec Dup = do x <- pop
> push x
> push x
>
> -- ( y x -- y+x )
> exec Plus = do x <- pop
> y <- pop
> push (y + x)
>
> -- ( y x -- y-x )
> exec Minus = do x <- pop
> y <- pop
> push (y - x)
>
> -- ( y x -- y*x )
> exec Mul = do x <- pop
> y <- pop
> push (y * x)
>
> -- ( y x -- y/x )
> exec Div = do x <- pop
> y <- pop
> push (y `div` x)
>
> -- ( y x -- y==x )
> exec Equal = do x <- pop
> y <- pop
> if y == x then push 1 else push 0
>
> -- ( y x -- y> exec Less = do x <- pop
> y <- pop
> if y < x then push 1 else push 0
>
> -- ( y x -- y>x )
> exec Greater = do x <- pop
> y <- pop
> if y > x then push 1 else push 0
>
> -- ( x -- )
> exec Out = do x <- pop
> liftIO $ (putStr (show x) >> putStr " " >> hFlush stdout)
>
> -- ( x -- )
> exec Emit = do x <- pop
> liftIO $ (putChar (chr x) >> hFlush stdout)
>
> -- stack effect depends on invoked function
> exec (Call fn) = do body <- asks (fromJust . Map.lookup fn)
> execSequence body
>
> -- ( -- I )
> exec GetI = do state <- get
> push $ counter state
>
> -- ( n m -- .. ) - n - high loop bound, m - low loop bound
> exec (Loop b) = do low <- pop
> high <- pop
> if low < high then mapM_ (doOnce b) [low .. high-1] else return () where
> doOnce program c = do state <- get
> put $ state { counter = c }
> execSequence program
>
> -- ( x -- .. ) - if x != 0 then t else e
> exec (If t e) = do x <- pop
> if x /= 0 then execSequence t else execSequence e
Environment contains definition of a
factorial function that calculates factorial of an item on top of stack, that is used by the main program to perform calculations.
> env = Map.fromList [ ("factorial",
> [ Dup
> , Number 1
> , Greater -- if n > 0
> , If [ Dup
> , Number 1
> , Minus
> , Call "factorial" -- factorial (n-1)
> , Mul -- *
> ]
> [ Drop
> , Number 1
> ] -- else 1
> ])
> ]
> sample = [ Number 8
> , Number 1
> , Loop [ GetI
> , Dup
> , Out
> , Call "factorial"
> , Out
> , Number 10
> , Emit
> ]
> ]
> main = do a <- runForth env initState sample
> return ()
