commit 924f4c65e750d5cc8e0e93be574b22b713ccc417 Author: Danila Fedorin Date: Sat Nov 21 19:48:10 2020 -0800 Finish initial prototype. diff --git a/elm.json b/elm.json new file mode 100644 index 0000000..5d8c32a --- /dev/null +++ b/elm.json @@ -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": {} + } +} diff --git a/index.html b/index.html new file mode 100644 index 0000000..00b0f94 --- /dev/null +++ b/index.html @@ -0,0 +1,16 @@ + + + + + + +

+ + + + diff --git a/src/Main.elm b/src/Main.elm new file mode 100644 index 0000000..d8dcbde --- /dev/null +++ b/src/Main.elm @@ -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 + } diff --git a/src/SeqSim/Evaluator.elm b/src/SeqSim/Evaluator.elm new file mode 100644 index 0000000..6e2d29b --- /dev/null +++ b/src/SeqSim/Evaluator.elm @@ -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 diff --git a/src/SeqSim/Model.elm b/src/SeqSim/Model.elm new file mode 100644 index 0000000..e3ce4f6 --- /dev/null +++ b/src/SeqSim/Model.elm @@ -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 } diff --git a/src/SeqSim/Parser.elm b/src/SeqSim/Parser.elm new file mode 100644 index 0000000..bdbfa80 --- /dev/null +++ b/src/SeqSim/Parser.elm @@ -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 diff --git a/src/SeqSim/Render.elm b/src/SeqSim/Render.elm new file mode 100644 index 0000000..c4106e4 --- /dev/null +++ b/src/SeqSim/Render.elm @@ -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 [] + diff --git a/src/SeqSim/Update.elm b/src/SeqSim/Update.elm new file mode 100644 index 0000000..776c31a --- /dev/null +++ b/src/SeqSim/Update.elm @@ -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 )