Change buttons to correct value
This commit is contained in:
parent
e6c7638324
commit
5a28a554a1
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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,13 +160,9 @@ 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) ]
|
||||
, p [] [ text ("Simulating access of address " ++ String.fromInt av.blockAddr) ]
|
||||
, buttonWrapper
|
||||
[ primaryButton "Back" AccessViewBack
|
||||
, primaryButton "Forward" AccessViewForward
|
||||
|
|
@ -177,11 +170,11 @@ viewAccessView m av =
|
|||
, h3 [] [ text "Access event log" ]
|
||||
, viewAccessLog av
|
||||
, h3 [] [ text "Current cache state" ]
|
||||
, viewCacheHierarchy <| effectiveCacheHierarchy currentCache av
|
||||
, 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,7 +202,6 @@ viewAccessInput : Model -> Html Msg
|
|||
viewAccessInput m =
|
||||
let
|
||||
parser =
|
||||
Parser.map (List.map (\i -> i // 4)) <|
|
||||
Parser.sequence
|
||||
{ start = ""
|
||||
, end = ""
|
||||
|
|
@ -221,12 +216,12 @@ viewAccessInput m =
|
|||
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."
|
||||
]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user