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