diff --git a/src/CacheSim/Update.elm b/src/CacheSim/Update.elm index 37a6368..d10ed3c 100644 --- a/src/CacheSim/Update.elm +++ b/src/CacheSim/Update.elm @@ -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) diff --git a/src/CacheSim/View.elm b/src/CacheSim/View.elm index 3f3a5f3..b2b8e34 100644 --- a/src/CacheSim/View.elm +++ b/src/CacheSim/View.elm @@ -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." ]