ASM interpreter in Haskell

asm.hs

import Control.Monad.State
import Data.Foldable
import Text.Read
import Control.Applicative
import System.IO

data Regs = Regs {
  ax::Int,
  cx::Int,
  dx::Int,
  bx::Int } deriving Show 

data RegPtr = Ax | Cx | Dx | Bx deriving Show
data Value = ValIm Int | ValRegP RegPtr deriving Show

data Cmd = 
  Add Value Value |
  Mov Value RegPtr
    deriving Show

newRegs :: Regs
newRegs = Regs 0 0 0 0

valueOf :: Value -> Regs -> Int
valueOf (ValIm v) _ = v
valueOf (ValRegP rp) regs = case rp of
  Ax -> ax regs
  Cx -> cx regs
  Dx -> dx regs
  Bx -> bx regs

execCmd :: Cmd -> State Regs ()
execCmd (Add v1 v2) = modify (\regs -> regs { ax = valueOf v1 regs + valueOf v2 regs })
execCmd (Mov v rp) = case rp of
  Ax -> modify (\regs -> regs { ax = valueOf v regs })
  Cx -> modify (\regs -> regs { cx = valueOf v regs })
  Dx -> modify (\regs -> regs { dx = valueOf v regs })
  Bx -> modify (\regs -> regs { bx = valueOf v regs })

exec :: [Cmd] -> State Regs Int
exec xs = do
  traverse_ execCmd xs
  gets ax

execRaw :: String -> State Regs (Maybe Int)
execRaw source = case traverse strToCmd $ lines source of
  Nothing -> pure Nothing 
  Just c -> Just <$> exec c

strToRegP :: String -> Maybe RegPtr
strToRegP "ax" = Just Ax
strToRegP "cx" = Just Cx
strToRegP "dx" = Just Dx
strToRegP "bx" = Just Bx
strToRegP _ = Nothing 

strToValRegP :: String -> Maybe Value
strToValRegP s = ValRegP <$> strToRegP s

strToValIm :: String -> Maybe Value
strToValIm s = ValIm <$> readMaybe s

strToVal :: String -> Maybe Value
strToVal s = strToValRegP s <|> strToValIm s

strToCmd :: String -> Maybe Cmd
strToCmd s = case words s of
  ["add", v1, v2] -> uncurry Add <$> ((,) <$> strToVal v1 <*> strToVal v2)
  ["mov", v, rp] -> uncurry Mov <$> ((,) <$> strToVal v <*> strToRegP rp)
  _ -> Nothing

main = do
  fileHandle <- openFile "./sample.asm" ReadMode
  contents <- hGetContents fileHandle
  print $ evalState (execRaw contents) newRegs
  pure ()

asm_addr.hs

{-# LANGUAGE NamedFieldPuns #-}

import Control.Applicative
import Control.Monad.State
import Control.Monad.Trans.Maybe
import Data.Foldable
import Data.IntMap.Lazy (updateMax)
import System.IO
import Text.Read (readMaybe)

data Regs = Regs
  { ax :: Int,
    cx :: Int,
    dx :: Int,
    bx :: Int
  }
  deriving (Show)

data RegPtr = Ax | Cx | Dx | Bx deriving (Show)

data Value = ValIm Int | ValRegP RegPtr deriving (Show)

data Cmd
  = Add Value Value
  | Mov Value RegPtr
  deriving (Show)

data Machine = Machine
  { regs :: Regs,
    ip :: Int,
    code :: [Cmd]
  }
  deriving (Show)

newRegs :: Regs
newRegs = Regs 0 0 0 0

newMachine :: [Cmd] -> Machine
newMachine = Machine newRegs 0

valueOf :: Value -> Regs -> Int
valueOf (ValIm v) _ = v
valueOf (ValRegP rp) regs = case rp of
  Ax -> ax regs
  Cx -> cx regs
  Dx -> dx regs
  Bx -> bx regs

machineIsCompleted :: Machine -> Bool
machineIsCompleted Machine {regs, ip, code} = ip < 0 || ip >= length code

isCompleted :: State Machine Bool
isCompleted = gets machineIsCompleted

updateIp :: Int -> Machine -> Machine
updateIp newIp m = m {ip = newIp}

updateReg :: Int -> RegPtr -> Machine -> Machine
updateReg newVal rp m@Machine {regs, ip, code} = m {regs = updateReg' newVal rp regs}
  where
    updateReg' _newVal _rp _regs = case _rp of
      Ax -> _regs {ax = _newVal}
      Cx -> _regs {cx = _newVal}
      Dx -> _regs {dx = _newVal}
      Bx -> _regs {bx = _newVal}

updateIpAndReg :: Int -> Int -> RegPtr -> Machine -> Machine
updateIpAndReg newIp newVal rp = updateIp newIp . updateReg newVal rp

execCmd :: State Machine (Maybe ())
execCmd = runMaybeT $
  forever $ do
    ic <- lift isCompleted
    when ic mzero
    Machine {regs, ip, code} <- get
    case code !! ip of
      Add v1 v2 -> modify $ updateIpAndReg (ip + 1) (valueOf v1 regs + valueOf v2 regs) Ax
      Mov v rp -> modify $ updateIpAndReg (ip + 1) (valueOf v regs) rp

getReturn :: (a, Machine) -> (Int, Machine)
getReturn (_, m) = ((ax . regs) m, m)

execRaw :: String -> Maybe Int
execRaw source = case traverse strToCmd $ lines source of
  Nothing -> Nothing
  Just cmds -> Just $ evalState (mapState getReturn execCmd) $ newMachine cmds

strToRegP :: String -> Maybe RegPtr
strToRegP "ax" = Just Ax
strToRegP "cx" = Just Cx
strToRegP "dx" = Just Dx
strToRegP "bx" = Just Bx
strToRegP _ = Nothing

strToValRegP :: String -> Maybe Value
strToValRegP s = ValRegP <$> strToRegP s

strToValIm :: String -> Maybe Value
strToValIm s = ValIm <$> readMaybe s

strToVal :: String -> Maybe Value
strToVal s = strToValRegP s <|> strToValIm s

strToCmd :: String -> Maybe Cmd
strToCmd s = case words s of
  ["add", v1, v2] -> uncurry Add <$> ((,) <$> strToVal v1 <*> strToVal v2)
  ["mov", v, rp] -> uncurry Mov <$> ((,) <$> strToVal v <*> strToRegP rp)
  _ -> Nothing

main = do
  fileHandle <- openFile "./sample.asm" ReadMode
  contents <- hGetContents fileHandle
  print $ execRaw contents
  pure ()

sample.asm

mov 2 ax
mov 3 bx
add ax bx