Change buttons to correct value

This commit is contained in:
Danila Fedorin 2019-05-31 23:37:32 -07:00
parent e6c7638324
commit 5a28a554a1
2 changed files with 64 additions and 61 deletions

View File

@ -45,8 +45,13 @@ updateAccess li m =
case xs of
[] -> Ok []
(i::t) ->
case accessCacheHierarchy i c of
Ok av -> Result.map ((::) (i, av, Down 0)) <| process (finalCacheHierarchy c (i, av, Done)) t
case accessCacheHierarchy (i // 4) c of
Ok av ->
let
newView = { blockAddr = i, accessEffects = av, position = Down 0, initialState = c }
in
Result.map ((::) newView)
<| process (finalCacheHierarchy newView) t
Err s -> Err s
accessResult = Maybe.andThen (\h -> Result.toMaybe <| process h li) m.hierarchy
@ -59,12 +64,15 @@ updateAccessViewForward : Model -> (Model, Cmd Msg)
updateAccessViewForward m =
let
afterStep = Maybe.map (intMapUpdate 0 accessViewForward) m.accessView
(newHierarchy, newAccessView) =
newAccessView =
case afterStep of
Just ((i, avs, Done)::[]) -> (Maybe.map (\h -> finalCacheHierarchy h (i, avs, Done)) m.hierarchy, Nothing)
Just ((i, avs, Done)::xs) -> (Maybe.map (\h -> finalCacheHierarchy h (i, avs, Done)) m.hierarchy, Just xs)
as_ -> (m.hierarchy, as_)
newModel = { m | accessView = newAccessView, hierarchy = newHierarchy }
Just (result::xs) ->
case (result.position, xs) of
(End, []) -> Nothing
(End, nxs) -> Just nxs
_ -> Just (result::xs)
as_ -> as_
newModel = { m | accessView = newAccessView }
cmd = Cmd.none
in
(newModel, cmd)

View File

@ -10,34 +10,31 @@ import Html.Attributes exposing (type_, class, value, for, classList, disabled,
import Html.Events exposing (onInput, onClick)
-- Button components, powered by Bootstrap
basicButton : List (Attribute Msg) -> String -> Html Msg
basicButton attrs s = input ([ type_ "button", value s, class "btn", class "btn-info" ] ++ attrs) []
button : List (Attribute Msg) -> String -> Html Msg
button attrs s = input ([ type_ "button", value s, class "btn"] ++ attrs) []
disabledButton : String -> Html Msg
disabledButton = basicButton [ disabled True ]
basicButton : Msg -> String -> Html Msg
basicButton msg s = button [ onClick msg ] s
advancedButton : List (Attribute Msg) -> String -> Msg -> Html Msg
advancedButton attrs s m = basicButton (attrs ++ [ onClick m ]) s
button : String -> Msg -> Html Msg
button s m = basicButton [ onClick m ] s
disabledButton : List (Attribute Msg) -> String -> Html Msg
disabledButton attrs = button (attrs ++ [ disabled True ])
dangerButton : String -> Msg -> Html Msg
dangerButton = advancedButton [ class "btn-danger" ]
dangerButton s m = button [ onClick m, class "btn-danger" ] s
primaryButton : String -> Msg -> Html Msg
primaryButton = advancedButton [ class "btn-primary" ]
primaryButton s m = button [ onClick m, class "btn-primary" ] s
secondaryButton : String -> Msg -> Html Msg
secondaryButton = advancedButton [ class "btn-secondary" ]
secondaryButton s m = button [ onClick m, class "btn-secondary" ] s
maybeButton : Maybe a -> String -> (a -> Msg) -> Html Msg
maybeButton m s f =
maybeButton : Maybe a -> List (Attribute Msg) -> String -> (a -> Msg) -> Html Msg
maybeButton m attrs s f =
case m of
Just v -> button s (f v)
_ -> disabledButton s
Just v -> button (attrs ++ [ onClick (f v) ]) s
_ -> disabledButton attrs s
resultButton : Result e a -> String -> (a -> Msg) -> Html Msg
resultButton : Result e a -> List (Attribute Msg) -> String -> (a -> Msg) -> Html Msg
resultButton = maybeButton << Result.toMaybe
-- Button wrapper (button group)
@ -105,8 +102,8 @@ viewRawCacheModelHierarchy rcmh =
Ok _ -> viewError True ""
Err e -> viewError False e
newButton = button "Add level" CreateRawModel
useButton = resultButton checkedResult "Use hierarchy" (UseHierarchy << Just)
newButton = primaryButton "Add level" CreateRawModel
useButton = resultButton checkedResult [ class "btn-primary" ] "Start simulation" (UseHierarchy << Just)
in
div []
[ h2 [] [ text "Cache hierarchy" ]
@ -163,25 +160,21 @@ viewCacheHierarchy ch =
viewAccessView : Model -> AccessView -> Html Msg
viewAccessView m av =
let
(i, _, _) = av
currentCache = Maybe.withDefault [] m.hierarchy
in
div []
[ h2 [] [ text "Access Simulation" ]
, p [] [ text ("Simulating access of address " ++ String.fromInt i) ]
, buttonWrapper
[ primaryButton "Back" AccessViewBack
, primaryButton "Forward" AccessViewForward
]
, h3 [] [ text "Access event log" ]
, viewAccessLog av
, h3 [] [ text "Current cache state" ]
, viewCacheHierarchy <| effectiveCacheHierarchy currentCache av
]
div []
[ h2 [] [ text "Access Simulation" ]
, p [] [ text ("Simulating access of address " ++ String.fromInt av.blockAddr) ]
, buttonWrapper
[ primaryButton "Back" AccessViewBack
, primaryButton "Forward" AccessViewForward
]
, h3 [] [ text "Access event log" ]
, viewAccessLog av
, h3 [] [ text "Current cache state" ]
, viewCacheHierarchy <| effectiveCacheHierarchy av
]
viewAccessLog : AccessView -> Html Msg
viewAccessLog (i, aes, ap) =
viewAccessLog av =
let
resultSpan r =
span [ classList [ ("badge", True), ("badge-success", r == Hit), ("badge-danger", r == Miss) ] ]
@ -191,14 +184,17 @@ viewAccessLog (i, aes, ap) =
, resultSpan ae.result
]
upEvent n ae = div [ class "event" ]
[ text <| "Updated L" ++ String.fromInt (List.length aes - n)
[ text <| "Updated L" ++ String.fromInt (List.length av.accessEffects - n)
]
events =
case ap of
Done -> []
Down n -> List.indexedMap downEvent <| List.take (n + 1) aes
Up n -> List.indexedMap downEvent aes ++
(List.indexedMap upEvent <| List.drop n aes)
case av.position of
Preview -> List.indexedMap downEvent av.accessEffects ++
(List.indexedMap upEvent av.accessEffects) ++
[ div [ class "event" ] [ text "Access complete. Viewing final cache state." ] ]
End -> []
Down n -> List.indexedMap downEvent <| List.take (n + 1) av.accessEffects
Up n -> List.indexedMap downEvent av.accessEffects ++
(List.indexedMap upEvent <| List.drop n av.accessEffects)
in
div [] events
@ -206,27 +202,26 @@ viewAccessInput : Model -> Html Msg
viewAccessInput m =
let
parser =
Parser.map (List.map (\i -> i // 4)) <|
Parser.sequence
{ start = ""
, end = ""
, separator = ","
, spaces = Parser.spaces
, item = Parser.int
, trailing = Parser.Optional
}
Parser.sequence
{ start = ""
, end = ""
, separator = ","
, spaces = Parser.spaces
, item = Parser.int
, trailing = Parser.Optional
}
parseErrorToString _ = "Unable to parse input. Please enter a sequence of numbers separated by commas."
parseResult = Parser.run (parser |. Parser.end) m.accessInput
checkedResult =
case parseResult of
Ok is -> if is == [] then Err "Please enter at least one number." else Ok is
Err e -> Err <| parseErrorToString e
accessButton = resultButton checkedResult "Access address" Access
accessButton = resultButton checkedResult [ class "btn-primary" ] "Access address" Access
errorHtml =
case checkedResult of
Ok _ -> viewError True ""
Err e -> viewError False e
editHierarchyButton = button "Edit hierarchy" (UseHierarchy Nothing)
editHierarchyButton = secondaryButton "Edit hierarchy" (UseHierarchy Nothing)
in
div []
[ h2 [] [ text "Run access simulation" ]
@ -246,7 +241,7 @@ viewDescription =
, p []
[ text <| "To use the simulator, first create a fitting cache configuration by using the \"Add level\" button,"
++ " as well as the settings provided by each individual cache level. When the cache is correctly specified, and"
++ " no warnings appear, click \"Use hierarchy\" to load the specified hierarchy and begin simulating. To simulate,"
++ " no warnings appear, click \"Start simulation\" to load the specified hierarchy and begin simulating. To simulate,"
++ " type a block address into the \"Access address\" field, and click \"Access\". This will bring forward the simulation"
++ " view, which will allow you to step through the steps of accessing a cache."
]