Finish initial prototype.
This commit is contained in:
commit
924f4c65e7
27
elm.json
Normal file
27
elm.json
Normal file
@ -0,0 +1,27 @@
|
||||
{
|
||||
"type": "application",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"elm-version": "0.19.1",
|
||||
"dependencies": {
|
||||
"direct": {
|
||||
"elm/browser": "1.0.2",
|
||||
"elm/core": "1.0.5",
|
||||
"elm/html": "1.0.0",
|
||||
"elm/parser": "1.1.0",
|
||||
"elm-community/list-extra": "8.2.4",
|
||||
"elm-community/maybe-extra": "5.2.0"
|
||||
},
|
||||
"indirect": {
|
||||
"elm/json": "1.1.3",
|
||||
"elm/time": "1.0.0",
|
||||
"elm/url": "1.0.0",
|
||||
"elm/virtual-dom": "1.0.2"
|
||||
}
|
||||
},
|
||||
"test-dependencies": {
|
||||
"direct": {},
|
||||
"indirect": {}
|
||||
}
|
||||
}
|
||||
16
index.html
Normal file
16
index.html
Normal file
@ -0,0 +1,16 @@
|
||||
<html>
|
||||
<head>
|
||||
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bootstrap@4.5.3/dist/css/bootstrap.min.css" integrity="sha384-TX8t27EcRE3e/ihU7zmQxVncDAy5uIKz4rEkgIXeMed4M0jlfIDPvg6uqKI2xXr2" crossorigin="anonymous">
|
||||
<script src="elm.js"></script>
|
||||
</head>
|
||||
<body>
|
||||
<div id="elm">
|
||||
</div>
|
||||
|
||||
<script>
|
||||
var app = Elm.Main.init({
|
||||
node: document.getElementById('elm')
|
||||
});
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
27
src/Main.elm
Normal file
27
src/Main.elm
Normal file
@ -0,0 +1,27 @@
|
||||
module Main exposing (main)
|
||||
import SeqSim.Model exposing (Model, Msg, Flags, begin)
|
||||
import SeqSim.Render exposing (view)
|
||||
import SeqSim.Update exposing (update)
|
||||
import Browser exposing (Document, document)
|
||||
|
||||
init : Flags -> (Model, Cmd Msg)
|
||||
init f = (begin, Cmd.none)
|
||||
|
||||
view : Model -> Document Msg
|
||||
view m =
|
||||
{ title = "Sequential Consistency Explorer"
|
||||
, body = SeqSim.Render.view m
|
||||
}
|
||||
|
||||
update : Msg -> Model -> (Model, Cmd Msg)
|
||||
update = SeqSim.Update.update
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions m = Sub.none
|
||||
|
||||
main = document
|
||||
{ init = init
|
||||
, view = view
|
||||
, update = update
|
||||
, subscriptions = subscriptions
|
||||
}
|
||||
73
src/SeqSim/Evaluator.elm
Normal file
73
src/SeqSim/Evaluator.elm
Normal file
@ -0,0 +1,73 @@
|
||||
module SeqSim.Evaluator exposing (allOutcomes)
|
||||
import SeqSim.Parser exposing (Prog, Source(..))
|
||||
import Dict exposing (Dict, get, insert)
|
||||
import Tuple exposing (first, second)
|
||||
import List.Extra exposing (uniqueBy)
|
||||
|
||||
shuffle : List a -> List a -> List (List a)
|
||||
shuffle l1 l2 =
|
||||
case (l1, l2) of
|
||||
([], _) -> [l2]
|
||||
(_, []) -> [l1]
|
||||
(x::xs, y::ys) ->
|
||||
List.map ((::) x) (shuffle xs l2) ++
|
||||
List.map ((::) y) (shuffle l1 ys)
|
||||
|
||||
shuffleAll : List (List a) -> List (List a)
|
||||
shuffleAll l =
|
||||
case l of
|
||||
[] -> [[]]
|
||||
(x::xs) -> List.concatMap (shuffle x) <| shuffleAll xs
|
||||
|
||||
type alias State = Dict String Int
|
||||
type alias Evaluator a = State -> (a, State)
|
||||
|
||||
succeed : a -> Evaluator a
|
||||
succeed a = \s -> (a, s)
|
||||
|
||||
andThen : (a -> Evaluator b) -> Evaluator a -> Evaluator b
|
||||
andThen f e = \s -> let (a, ss) = e s in f a ss
|
||||
|
||||
map : (a -> b) -> Evaluator a -> Evaluator b
|
||||
map f e = \s -> let (a, ss) = e s in (f a, ss)
|
||||
|
||||
run : Evaluator a -> State -> (a, State)
|
||||
run e s = e s
|
||||
|
||||
getVar : String -> Evaluator Int
|
||||
getVar x = \s -> (Maybe.withDefault 0 (Dict.get x s), s)
|
||||
|
||||
setVar : String -> Int -> Evaluator ()
|
||||
setVar x v = \s -> ((), Dict.insert x v s)
|
||||
|
||||
mapM_ : (a -> Evaluator b) -> List a -> Evaluator ()
|
||||
mapM_ f l = map (\_ -> ()) <| mapM f l
|
||||
|
||||
mapM : (a -> Evaluator b) -> List a -> Evaluator (List b)
|
||||
mapM f l =
|
||||
case l of
|
||||
[] -> succeed []
|
||||
(x::xs) -> andThen (\b -> map ((::) b) <| mapM f xs) (f x)
|
||||
|
||||
evalSource : Source -> Evaluator Int
|
||||
evalSource s =
|
||||
case s of
|
||||
Var x -> getVar x
|
||||
Const i -> succeed i
|
||||
|
||||
evalCmd : (String, Source) -> Evaluator ()
|
||||
evalCmd (x, s) = evalSource s |> andThen (setVar x)
|
||||
|
||||
evalProg : Prog -> Evaluator ()
|
||||
evalProg = mapM_ evalCmd
|
||||
|
||||
runShuffled : List String -> List Prog -> List (Prog, List Int)
|
||||
runShuffled xs ps =
|
||||
let
|
||||
getVars = mapM getVar xs
|
||||
runProg p = (p, first <| run (evalProg p |> andThen (\_ -> getVars)) Dict.empty)
|
||||
in
|
||||
List.map runProg <| shuffleAll ps
|
||||
|
||||
allOutcomes : List String -> List Prog -> List (Prog, List Int)
|
||||
allOutcomes xs ps = uniqueBy second <| runShuffled xs ps
|
||||
19
src/SeqSim/Model.elm
Normal file
19
src/SeqSim/Model.elm
Normal file
@ -0,0 +1,19 @@
|
||||
module SeqSim.Model exposing (Model, Msg(..), Flags, begin)
|
||||
|
||||
type alias Model =
|
||||
{ programs : List String
|
||||
, variables : String
|
||||
, selected : Maybe Int
|
||||
}
|
||||
|
||||
type Msg
|
||||
= ChangeProgram Int String
|
||||
| AddProgram
|
||||
| DeleteProgram Int
|
||||
| ChangeVariables String
|
||||
| SelectOutcome Int
|
||||
|
||||
type alias Flags = ()
|
||||
|
||||
begin : Model
|
||||
begin = { programs = ["A=1", "R1=A\nB=1", "R2=B\nR3=A" ], variables = "R1, R2, R3", selected = Nothing }
|
||||
77
src/SeqSim/Parser.elm
Normal file
77
src/SeqSim/Parser.elm
Normal file
@ -0,0 +1,77 @@
|
||||
module SeqSim.Parser exposing (parse, valid, vars, varsValid, Prog, Source(..))
|
||||
import Parser exposing (Parser, Step(..), Trailing(..), run, end, succeed, loop, sequence, (|=), (|.), spaces, symbol, int, map, oneOf, variable, sequence)
|
||||
import Char exposing (isAlpha, isAlphaNum)
|
||||
import Set exposing (empty)
|
||||
import Tuple
|
||||
|
||||
type alias Prog = List (String, Source)
|
||||
type Source = Var String | Const Int
|
||||
|
||||
parseVar : Parser String
|
||||
parseVar = variable
|
||||
{ start = isAlpha
|
||||
, inner = isAlphaNum
|
||||
, reserved = Set.empty
|
||||
}
|
||||
|
||||
parseSource : Parser Source
|
||||
parseSource = oneOf
|
||||
[ Parser.map Const int
|
||||
, Parser.map Var parseVar
|
||||
]
|
||||
|
||||
parseCmd : Parser (String, Source)
|
||||
parseCmd = succeed Tuple.pair
|
||||
|= parseVar
|
||||
|. spaces
|
||||
|. symbol "="
|
||||
|. spaces
|
||||
|= parseSource
|
||||
|
||||
parseProg : Parser Prog
|
||||
parseProg =
|
||||
let
|
||||
step s =
|
||||
oneOf
|
||||
[ succeed (\cmd -> Loop (cmd::s))
|
||||
|= parseCmd
|
||||
|. spaces
|
||||
, spaces
|
||||
|> Parser.map (\_ -> Done (List.reverse s))
|
||||
]
|
||||
in
|
||||
loop [] step
|
||||
|
||||
parseVars : Parser (List String)
|
||||
parseVars = sequence
|
||||
{ start = ""
|
||||
, separator = ","
|
||||
, end = ""
|
||||
, spaces = spaces
|
||||
, item = parseVar
|
||||
, trailing = Optional
|
||||
}
|
||||
|
||||
vars : String -> Maybe (List String)
|
||||
vars s =
|
||||
case run (succeed (\x -> x) |. spaces |= parseVars |. spaces |. end) s of
|
||||
Ok p -> Just p
|
||||
Err _ -> Nothing
|
||||
|
||||
varsValid : String -> Bool
|
||||
varsValid s =
|
||||
case vars s of
|
||||
Just _ -> True
|
||||
Nothing -> False
|
||||
|
||||
parse : String -> Maybe Prog
|
||||
parse s =
|
||||
case run (succeed (\x->x) |. spaces |= parseProg |. end) s of
|
||||
Ok p -> Just p
|
||||
Err _ -> Nothing
|
||||
|
||||
valid : String -> Bool
|
||||
valid s =
|
||||
case parse s of
|
||||
Just _ -> True
|
||||
Nothing -> False
|
||||
120
src/SeqSim/Render.elm
Normal file
120
src/SeqSim/Render.elm
Normal file
@ -0,0 +1,120 @@
|
||||
module SeqSim.Render exposing (view)
|
||||
import SeqSim.Model exposing (Model, Msg(..))
|
||||
import SeqSim.Parser exposing (parse, vars, valid, varsValid, Prog, Source(..))
|
||||
import SeqSim.Evaluator exposing (..)
|
||||
import Maybe.Extra exposing (combine)
|
||||
import List.Extra exposing (zip, getAt)
|
||||
import Tuple exposing (second)
|
||||
import Html exposing (Html, text, textarea, input, label, small, div, span, button, a, h1, h2, h3, h4, h5, br)
|
||||
import Html.Attributes exposing (class, classList, id, for, type_, value, href)
|
||||
import Html.Events exposing (onClick, onInput)
|
||||
|
||||
view : Model -> List (Html Msg)
|
||||
view m =
|
||||
[ div [ class "container" ]
|
||||
[ h1 [] [ text "Sequential Consistency Simulator" ]
|
||||
, viewProgs m.programs
|
||||
, viewOutcomes m
|
||||
]
|
||||
]
|
||||
|
||||
toolbar : Html Msg
|
||||
toolbar = div [ class"btn-group" ]
|
||||
[ button
|
||||
[ type_ "button"
|
||||
, class "btn btn-primary"
|
||||
, onClick AddProgram ]
|
||||
[ text "Add Program" ]
|
||||
]
|
||||
|
||||
viewProgs : List String -> Html Msg
|
||||
viewProgs ps = div []
|
||||
[ h2 [] [ text "Programs" ]
|
||||
, toolbar
|
||||
, div [ class "mt-2 row row-cols-1 row-cols-md-2 row-cols-lg-4" ]
|
||||
<| List.indexedMap viewProg ps
|
||||
]
|
||||
|
||||
viewProg : Int -> String -> Html Msg
|
||||
viewProg i s = div [ class "col mb-2" ]
|
||||
[ div [ class "card" ]
|
||||
[ div [ class "card-body" ]
|
||||
[ h5 [ class "card-title" ] [ text <| "Program " ++ String.fromInt (i+1) ]
|
||||
, viewProgValidity s
|
||||
, textarea [ class "mt-2 mb-2 form-control", onInput (ChangeProgram i), value s ] [ ]
|
||||
, a [ class "btn btn-outline-danger", onClick (DeleteProgram i) ] [ text "Remove" ]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
viewProgValidity : String -> Html Msg
|
||||
viewProgValidity s =
|
||||
if valid s
|
||||
then span [ class "text-success" ] [ text "Valid" ]
|
||||
else span [ class "text-danger" ] [ text "Invalid" ]
|
||||
|
||||
viewOutcomes : Model -> Html Msg
|
||||
viewOutcomes m = div []
|
||||
[ h2 [] [ text "Possible Outcomes" ]
|
||||
, div [ class "form-group" ]
|
||||
[ label [ for "variables" ] [ text "Interesting Variables" ]
|
||||
, input
|
||||
[ type_ "text"
|
||||
, id "variables"
|
||||
, class "form-control"
|
||||
, if String.isEmpty m.variables
|
||||
then classList []
|
||||
else if varsValid m.variables then class "is-valid" else class "is-invalid"
|
||||
, value m.variables
|
||||
, onInput ChangeVariables
|
||||
] []
|
||||
, small [ class "form-text text-muted" ]
|
||||
[ text "Enter the variables you want included in the final outcomes, separated by a comma."
|
||||
]
|
||||
]
|
||||
, viewOutcomeTable m
|
||||
]
|
||||
|
||||
viewOutcomeTable : Model -> Html Msg
|
||||
viewOutcomeTable m =
|
||||
case (vars m.variables, combine <| List.map parse m.programs) of
|
||||
(Just (x::xs), Just ps) ->
|
||||
let all = allOutcomes (x::xs) ps
|
||||
in div [ class "card" ] <| List.singleton <| div [ class "card-body" ]
|
||||
[ div [ class "row" ]
|
||||
[ div [ class "col border-right col-auto" ]
|
||||
<| List.indexedMap (viewRow (x::xs))
|
||||
<| List.map second all
|
||||
, div [ class "col" ] <|
|
||||
case Maybe.andThen (\i -> getAt i all) m.selected of
|
||||
Nothing -> []
|
||||
Just (p, o) ->
|
||||
[ viewProgStr p
|
||||
]
|
||||
]
|
||||
]
|
||||
_ -> div [] []
|
||||
|
||||
viewRow : List String -> Int -> List Int -> Html Msg
|
||||
viewRow xs i vs = div []
|
||||
[ a [ href "#", onClick (SelectOutcome i) ]
|
||||
[ text <| stringFromOutcome xs vs
|
||||
]
|
||||
]
|
||||
|
||||
stringFromOutcome : List String -> List Int -> String
|
||||
stringFromOutcome xs vs = List.map2 (\x v -> x ++ " = " ++ String.fromInt v) xs vs
|
||||
|> String.join ", "
|
||||
|
||||
viewProgStr : Prog -> Html Msg
|
||||
viewProgStr p =
|
||||
let
|
||||
sourceStr s =
|
||||
case s of
|
||||
Var x -> x
|
||||
Const i -> String.fromInt i
|
||||
in
|
||||
List.map (\(x, s) -> text <| x ++ " = " ++ sourceStr s) p
|
||||
|> List.intersperse (br [] [])
|
||||
|> div []
|
||||
|
||||
25
src/SeqSim/Update.elm
Normal file
25
src/SeqSim/Update.elm
Normal file
@ -0,0 +1,25 @@
|
||||
module SeqSim.Update exposing (update)
|
||||
import SeqSim.Model exposing (Model, Msg(..))
|
||||
|
||||
update : Msg -> Model -> (Model, Cmd Msg)
|
||||
update msg m =
|
||||
case msg of
|
||||
AddProgram -> ({ m | programs = m.programs ++ [""] }, Cmd.none)
|
||||
ChangeProgram i ns ->
|
||||
( { m
|
||||
| programs = List.indexedMap (\j n -> if i == j then ns else n) m.programs
|
||||
, selected = Nothing
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
DeleteProgram i ->
|
||||
( { m
|
||||
| programs = List.take i m.programs ++ List.drop (i+1) m.programs
|
||||
, selected = Nothing
|
||||
}
|
||||
, Cmd.none
|
||||
)
|
||||
ChangeVariables s ->
|
||||
( { m | variables = s, selected = Nothing }, Cmd.none )
|
||||
SelectOutcome i ->
|
||||
( { m | selected = Just i }, Cmd.none )
|
||||
Loading…
Reference in New Issue
Block a user