Finish initial prototype.

This commit is contained in:
Danila Fedorin 2020-11-21 19:48:10 -08:00
commit 924f4c65e7
8 changed files with 384 additions and 0 deletions

27
elm.json Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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 )