Instantly share code, notes, and snippets.

@ggb ggb/RegisterMachine.elm
Last active Feb 4, 2017

Embed
What would you like to do?
A Universal Register Machine implemented in Elm and inspired by http://www.thattommyhall.com/clojured/ Copy the following code to http://www.elm-lang.org/try and hit the compile-button.
module RegisterMachine exposing (..)
import Html
import Time exposing (Time, second)
import Array exposing (Array)
import Html exposing (..)
import Html.Attributes exposing (style)
type Msg
= Tick Time
subscriptions : RegisterMachine -> Sub Msg
subscriptions model =
Time.every second Tick
main =
Html.program
{ init = init
, view = view
, update = stepper
, subscriptions = subscriptions
}
{-
- MODEL
-}
type alias Register = Int
type alias CodeLine = Int
type Statement
= Inc Register CodeLine
| Dec Register CodeLine CodeLine
| End
type alias RegisterMachine =
{ registers: Array Register
, program: Array Statement
, lineNumber: Int
, result: Maybe Int
}
program : List Statement
program =
[ Dec 1 1 2
, Inc 0 0
, Dec 2 3 4
, Inc 0 2
, End
]
machine : RegisterMachine
machine =
{ registers = [0, 1, 2] |> Array.fromList
, program = program |> Array.fromList
, lineNumber = 0
, result = Nothing
}
init = (machine, Cmd.none)
{-
- VIEW
-}
drawRegisters registers =
let
tdStyle =
[("border", "2px solid #293C4B"), ("padding", "0.5rem 1.5rem"), ("text-align", "left")]
fstRow =
(Array.length registers - 1)
|> List.range 0
|> List.map (\ele -> td [style (("background", "#60B5CC") :: tdStyle)] [ text (toString ele)])
|> tr []
scdRow =
Array.toList registers
|> List.map (\ele -> td [style tdStyle] [ text (toString ele)])
|> tr []
in
div
[]
[ h2
[ style [("margin", "12px 0px")]]
[ text "Registers:" ]
, table
[ style [("border-collapse", "collapse")]]
[ fstRow
, scdRow
]
]
drawProgram lineNumber program =
let
len = List.range 0 (Array.length program - 1)
list =
Array.toList program
|> List.map2 (,) len
|> List.map (\(index, statement) ->
li
[ if index == lineNumber then
style [("background", "#60B5CC"), ("padding", "7px 0px"), ("font-family", "DejaVu Sans Mono")]
else
style [("padding", "7px 0px"), ("font-family", "DejaVu Sans Mono")]
]
[ text (toString index ++ ": " ++ toString statement) ]
)
in
div
[]
[ h2
[ style [("margin", "17px 0px")]]
[ text "Program:" ]
, ul
[ style [("list-style-type", "none"), ("padding-left", "0px"), ("margin-top", "5px")]]
list
]
drawResult result =
let t =
case result of
Just val ->
"Result: " ++ (toString val)
Nothing ->
"In Progress"
in
div
[ ]
[ text t ]
view : RegisterMachine -> Html Msg
view { registers, program, lineNumber, result } =
div
[ style [("font-size", "28px"), ("padding-left", "12px")]]
[ drawRegisters registers
, drawProgram lineNumber program
, drawResult result
]
{-
- UPDATE
-}
increment n registers =
let
current = Array.get n registers |> Maybe.withDefault 0
in
Array.set n (current + 1) registers
decrement n registers =
let
current = Array.get n registers |> Maybe.withDefault 0
in
if current == 0 then
registers
else
Array.set n (current - 1) registers
decBranch n m k registers =
let
current = Array.get n registers |> Maybe.withDefault 0
in
if current /= 0 then
m
else
k
stepper fps machine =
let
{ registers, program, lineNumber, result} = machine
statement = Array.get lineNumber program |> Maybe.withDefault End
in
case statement of
Inc n m ->
({ machine | registers = increment n registers
, lineNumber = m
}, Cmd.none)
Dec n m k ->
({ machine | registers = decrement n registers
, lineNumber = decBranch n m k registers
}, Cmd.none)
End ->
let
result =
Array.get 0 registers
|> Maybe.withDefault -1
|> Just
in
({ machine | result = result }, Cmd.none)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment