Compare commits

..

2 Commits

3 changed files with 95 additions and 82 deletions

View File

@ -2,15 +2,21 @@ module CacheSim.AccessView exposing (..)
import CacheSim.Cache exposing (..)
import CacheSim.Hierarchy exposing (..)
type AccessPosition = Down Int | Up Int | Done
type alias AccessView = (List (AccessEffect Cache), AccessPosition)
type AccessPosition = Down Int | Up Int | Preview | End
type alias AccessView =
{ initialState : CacheHierarchy
, blockAddr : BlockAddr
, accessEffects : List (AccessEffect Cache)
, position : AccessPosition
}
accessPositionForward : Int -> AccessPosition -> AccessPosition
accessPositionForward depth av =
case av of
Down n -> if n == depth - 1 then Up n else Down (n + 1)
Up n -> if n == 0 then Done else Up (n - 1)
Done -> Done
Up n -> if n == 0 then Preview else Up (n - 1)
Preview -> End
End -> End
accessPositionBack : Int -> AccessPosition -> AccessPosition
accessPositionBack depth av =
@ -18,41 +24,43 @@ accessPositionBack depth av =
Down 0 -> Down 0
Down n -> Down (n-1)
Up n -> if n == (depth - 1) then Down n else Up (n + 1)
Done -> Up 0
Preview -> Up 0
End -> Preview
accessPositionDone : AccessPosition -> Bool
accessPositionDone av =
case av of
Done -> True
End -> True
_ -> False
accessViewForward : AccessView -> AccessView
accessViewForward (l, ap) = (l, accessPositionForward (List.length l) ap)
accessViewForward av = { av | position = accessPositionForward (List.length av.accessEffects) av.position }
accessViewBack : AccessView -> AccessView
accessViewBack (l, ap) = (l, accessPositionBack (List.length l) ap)
accessViewBack av = { av | position = accessPositionBack (List.length av.accessEffects) av.position }
accessViewDone : AccessView -> Bool
accessViewDone (_, ap) = accessPositionDone ap
accessViewDone av = accessPositionDone av.position
finalCacheHierarchy : CacheHierarchy -> AccessView -> CacheHierarchy
finalCacheHierarchy ch (l, ap) =
List.map .output l ++ List.drop (List.length l) ch
finalCacheHierarchy : AccessView -> CacheHierarchy
finalCacheHierarchy av =
List.map .output av.accessEffects ++ List.drop (List.length av.accessEffects) av.initialState
effectiveCacheHierarchy : CacheHierarchy -> AccessView -> CacheHierarchy
effectiveCacheHierarchy c (l, ap) =
effectiveCacheHierarchy : AccessView -> CacheHierarchy
effectiveCacheHierarchy av =
let
finalContents = List.map .output l
unaccessed = List.drop (List.length l) c
finalContents = List.map .output av.accessEffects
unaccessed = List.drop (List.length av.accessEffects) av.initialState
notDone =
case ap of
Done -> []
Down _ -> List.take (List.length l) c
Up n -> List.take n c
case av.position of
Preview -> []
End -> []
Down _ -> List.take (List.length av.accessEffects) av.initialState
Up n -> List.take n av.initialState
done =
case ap of
Done -> finalContents
case av.position of
Preview -> finalContents
End -> finalContents
Down _ -> []
Up n -> List.drop n finalContents
in

View File

@ -45,8 +45,13 @@ updateAccess li m =
case xs of
[] -> Ok []
(i::t) ->
case accessCacheHierarchy i c of
Ok av -> Result.map ((::) (av, Down 0)) <| process (finalCacheHierarchy c (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 ((avs, Done)::[]) -> (Maybe.map (\h -> finalCacheHierarchy h (avs, Done)) m.hierarchy, Nothing)
Just ((avs, Done)::xs) -> (Maybe.map (\h -> finalCacheHierarchy h (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,23 +160,21 @@ viewCacheHierarchy ch =
viewAccessView : Model -> AccessView -> Html Msg
viewAccessView m av =
let
currentCache = Maybe.withDefault [] m.hierarchy
in
div []
[ h2 [] [ text "Access Simulation" ]
, 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 (aes, ap) =
viewAccessLog av =
let
resultSpan r =
span [ classList [ ("badge", True), ("badge-success", r == Hit), ("badge-danger", r == Miss) ] ]
@ -189,14 +184,17 @@ viewAccessLog (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
@ -204,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" ]
@ -244,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."
]