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