Writing a 'Human Resource Machine' Emulator in Elm

The easiest way to represent instructions is as a Union type:

type Instruction = Inbox
		 | Outbox

Hard-coding the solution program as an array of instructions makes this proof of concept easier:

program : Array Instruction
program =
  Array.fromList
	 [ Inbox
	 , Outbox
	 , Inbox
	 , Outbox
	 , Inbox
	 , Outbox
	 ]

It seems like every Elm program has a "Model" type, and this is no exception:

import Array exposing (Array)

type alias Model =
    { program : Array Instruction
    , status  : MachineStatus
    }

So, model is a combination between a program and an emulated "machine".

There is some forward thinking going on in this design. The model could be slightly simpler for this MVP, but part of the goal of this iteration is to explore what the solution may look like in the future.

• program is listed as part of the model, although it needn't be in this case, since it is hard-coded and won't change. However, we want this to be different very soon, so it makes sense to just put this on the model, for now.
• status is a separate type because in the future I want to maintain a list of all statuss, for debuggability. It becomes just a little easier to refactor to a list if it is separate, and allows for a little bit of exploration of what a MachineStatus type should contain.

type alias MachineStatus =
    { status : Status
    , held   : Maybe Value
    , input  : List Value
    , output : List Value
    , pc     : Int
    }

type Status = Running | Complete | Error String

• status signifies execution completion. I strongly suspect that this will go somewhere else, as it feels strange to have it in here. But, this is OK for now.
• held represents the current value that is being held. In HRM, what you hold is akin to a CPU register; your character do calculations with and moves values to and from their hands – which, really, is just like real life. This is a Maybe because it is possible for the hands to be empty.
• input represents the input conveyor. Values are taken from it and manipulated.
• output represents the output conveyor, onto which values are placed.
• pc represents the "program counter". This is the index of the next instruction to be executed.

You may notice that the above references a Value. This is the "values" that may be worked with in the game:

type Value = Int

For now, we are only working with integers.

I'm not sure where to mention this, but I want to include here the bits and pieces that make the program actually run. I think its helpful to get them out of the way.

import Html.App as Html

main : Program Never
main =
  Html.program { init = init, view = view, update = update, subscriptions = subscriptions }

The program is an Html.program, with the basic wiring.

import Time exposing (Time, second)

subscriptions : Model -> Sub Msg
subscriptions model =
  Time.every second Tick

Tick each second. The only input the program receives for now are ticks.

The view can also be made fairly simple:

import Html exposing (Html, div, text)


-- VIEW

renderState : MachineState -> Html a
renderState state =
    div [] [text (toString state)]


view : Model -> Html Msg
view model =
  div []
    [ div [] [text (toString model.program)]
    , renderState model.state
    ]

Instead of worrying about anything very complicated, we just use Elm's toString method to create a user-readable version of the data structure.

The "meat" of the application is the update functionality. This is the code that actually emulates the machine.

With our types defined, the code is not necessarily overly-complicated:

-- UPDATE

type Msg
  = Tick Time


update : Msg -> Model -> (Model, Cmd Msg)
update action model =
  case action of
    Tick newTime ->
	let
	    isComplete = model.state.status
	in
	    case isComplete of
		Running -> (stepModel model, Cmd.none)
		_       -> (model, Cmd.none)

The function update is the main loop. On each tick of the clock, apply an instrution and compute the next version of the model if the machine is still running.

I didn't point this out earlier, but there are two other status types: Complete and Error String. Complete indicates that the program completed successfully, and is no longer running. Error String provides a way to report an error if the program tries to do something invalid, such as:

• Finish without the correct values being on the output conveyor.
• Tries to pick up something from the input conveyor when the conveyor is empty.
• Tries to place something on the output conveyor when the character is not holding anything.

Although, there are others. Next up, stepModel, which is where things begin to get interesting.

stepModel : Model -> Model
stepModel model =
  let curr = currentInstruction model.program model.state.pc
  in case curr of
    Just instruction  ->
      processInstruction instruction model
    Nothing        ->
      updateState model (\s-> { s | status = Error "The machine attempted to access an invalid instruction."})

Before calculating the next state, Calculating the next value of the model involves:

1. Finding the current instruction to execute.
2. Performing a specific action based upon the current instruction.
3. Performing some bookkeeping: Move to the next counter, complete the state if the program has finished, etc.

Lets look at each of these functions, one at a time.

currentInstruction : Array Instruction -> Int -> Instruction
currentInstruction instructions pc =
  case (Array.get pc instructions) of
    Just a  -> a
    Nothing -> Debug.crash "you're trying to access an instruction that doesn't exist"

This is one of those situations where a type system makes things interesting. I wouldn't have thought about Array.get possibly failing without it returning a Maybe, which I then have to deal with.

updateState : Model -> (MachineState -> MachineState) -> Model
updateState model updater =
    let newState = updater model.state
    in { model | state = newState }


stepPC : Model -> Model
stepPC model =
    updateState model (\s-> {s | pc = s.pc + 1 })


completeIfFinished : Model -> Model
completeIfFinished model =
  let programLength = Array.length model.program
      pc = model.state.pc
  in if pc < programLength then
	 model
     else
	 updateState model complete


shiftInboxToHands : Model -> Model
shiftInboxToHands model =
  let first = List.head model.state.input
      rest  = case List.tail model.state.input of
		Just r  -> r
		Nothing -> []
  in case first of
       Just val ->
	   updateState model (\s-> { s | held = Just val, input = rest})
       Nothing -> updateState model (\s-> {s | status = Error "tried to pick up an item from the inbox, but inbox was empty" })


-- state manipulators

complete : MachineState -> MachineState
complete state = { state | status = Complete }


shiftHandsToOutbox : Model -> Model
shiftHandsToOutbox model =
  let currentState = model.state
  in case model.state.held of
    Nothing  -> updateState model complete
    Just val -> { model | state =
		     { currentState
			 | held = Nothing,
			   output  = (val :: currentState.output)
		     }}

stepModel : Model -> Model
stepModel model =
  let curr = currentInstruction model.program model.state.pc
  in case curr of
    Inbox ->
      shiftInboxToHands model |> stepPC |> completeIfFinished
    Outbox ->
      shiftHandsToOutbox model |> stepPC |> completeIfFinished