[Haskell-beginners] I wrote a state monad example - help me make it more Haskellic

Rohit Garg rpg.314 at gmail.com
Sat Jul 23 17:56:20 CEST 2011


Hi,

I have written my first program using state monads and I would like
some feedback from the community regarding how Haskellic it is. It's a
simple simulator for a toy microprocessor. The contents of registers
are the state that needs to be preserved across instruction
evaluation. I have tried to implement the code dealing with monads
using both >>=, >> and the do block.

Also, I'd like to make the RegisterVal type Word32, but when I do that, then
================
initial_rf = [0,0,0,0]
================
this line fails to typecheck.

If there are any bugs or non-idiomatic use of haskell, please let me know.

Thanks and regards,
Rohit

=================
import Data.Word
import Control.Monad.State

type RegisterVal = Int
type RegisterFile = [RegisterVal]
type RegisterID = Int

--destination comes first
data Instruction = Add RegisterID RegisterID RegisterID
                    | Sub RegisterID RegisterID RegisterID
                    | Mov RegisterID RegisterID
                    | Movc RegisterID RegisterVal
                    deriving (Show)

get_operand :: RegisterFile -> RegisterID -> RegisterVal
get_operand registers regid = registers !! regid

store_operand :: RegisterFile -> RegisterID -> RegisterVal -> RegisterFile
store_operand registers regid value = (take regid registers) ++
[value] ++ (drop (regid+1) registers)

eval_inst :: Instruction -> RegisterFile -> RegisterFile
eval_inst (Add dstid src1id src2id) rf = rf_final
            where rf_final =  store_operand rf dstid res    --store
                  res = op1 + op2                           --evaluate
                  (op1, op2) = (get_operand rf src1id , get_operand rf
src2id)   --load

eval_inst (Sub dstid src1id src2id) rf = rf_final
            where rf_final =  store_operand rf dstid res    --store
                  res = op1 - op2                           --evaluate
                  (op1, op2) = (get_operand rf src1id , get_operand rf
src2id)   --load

eval_inst (Mov dstid srcid) rf = rf_final
            where rf_final =  store_operand rf dstid res    --store
                  res = op1                                 --evaluate
                  op1 = get_operand rf srcid                --load

eval_inst (Movc dstid imm) rf = rf_final
            where rf_final =  store_operand rf dstid res    --store
                  res = imm                                 --evaluate

initial_rf :: RegisterFile
initial_rf = [0,0,0,0]

insts = [Movc 0 231, Movc 1 (-42), Add 2 1 0, Sub 3 1 0]

execute_inst2 :: Instruction -> State RegisterFile RegisterFile
{-
execute_inst2 inst = get >>= \rf1 -> let rf2 = eval_inst inst rf1
                                    in put rf2 >> return rf2
-}
execute_inst2 inst = do
    rf1 <- get
    let rf2 = eval_inst inst rf1
    put rf2
    return rf2

execute_program2 :: [Instruction] -> State RegisterFile RegisterFile
execute_program2 [] = do
    rf <- get
    put rf
    return rf

execute_program2 (x:xs) = do
    rf1 <- execute_inst2 x
    rf2 <- execute_program2 xs
    put rf2
    return rf2
{-
execute_program2 [] = get >>= \rf ->
                            put rf >> return rf

execute_program2 (x:xs) =   (execute_inst2 x) >>= \a ->
                            (execute_program2 xs) >>= \b ->
                            return b
-}
main :: IO ()
main = putStrLn $ show $ execState (execute_program2 insts) initial_rf

-- 
Rohit Garg

http://rpg-314.blogspot.com/



More information about the Beginners mailing list