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

[aditya siram]

Hi Rohit,
I've refactored your program a little bit. Hope you don't mind. The
main change I made was, since there can only be four registers, to
create explicit datatypes for each register and turn your RegisterFile
datatype into a 4-tuple. The corresponding setter and getter,
store_operand and get_operand have also been changed to reflect the
new datatypes. This way there can never be errors with list indices
etc.

I've also used two new State monad functions of which you might be unaware:
1. modify :: modifies state with the given function.
2. mapM_ :: is like a "map" but takes a monadic action and applied it
to the given ist.

The output is stil the same as your code, but I've added a little type safety.

I haven't covered every detail of the changes but if you're reading
through it and get stuck, please let me know.

-deech

import Control.Monad.State

type RegisterVal = Int
data RegisterID = R1 | R2 | R3 | R4 deriving Show
type RegisterFile = (RegisterVal, RegisterVal, RegisterVal, RegisterVal)

get_operand :: RegisterFile -> RegisterID -> RegisterVal
get_operand (r1,_,_,_) R1 = r1
get_operand (_,r2,_,_) R2 = r2
get_operand (_,_,r3,_) R3 = r3
get_operand (_,_,_,r4) R4 = r4

store_operand :: RegisterFile -> RegisterID -> RegisterVal -> RegisterFile
store_operand (r1,r2,r3,r4) r v = case r of
                                    R1 -> (v,r2,r3,r4)
                                    R2 -> (r1,v,r3,r4)
                                    R3 -> (r1,r2,v,r4)
                                    R4 -> (r1,r2,r3,v)

eval_inst :: Instruction -> RegisterFile -> RegisterFile
eval_inst inst rf = let store_op' = store_operand rf
                        get_op'   = get_operand rf
                    in
                      case inst of
                       Add dest rid1 rid2 -> store_op' dest (get_op'
rid1 + get_op' rid2)
                       Sub dest rid1 rid2 -> store_op' dest (get_op'
rid1 - get_op' rid2)
                       Mov dest rid       -> store_op' dest (get_op' rid)
                       Movc dest v        -> store_op' dest v

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

initial_rf :: RegisterFile
initial_rf = (0,0,0,0)

insts = [Movc R1 231, Movc R2 (-42), Add R3 R2 R1, Sub R4 R2 R1]

execute_program2 :: [Instruction] -> State RegisterFile ()
execute_program2 = mapM_ (modify . eval_inst)

main :: IO ()
main = putStrLn $ show $ execState (execute_program2 insts) initial_rf