Compare commits

...

4 Commits

5 changed files with 89 additions and 17 deletions

25
elm.json Normal file
View File

@ -0,0 +1,25 @@
{
"type": "application",
"source-directories": [
"src"
],
"elm-version": "0.19.0",
"dependencies": {
"direct": {
"elm/browser": "1.0.1",
"elm/core": "1.0.2",
"elm/html": "1.0.0",
"elm/parser": "1.1.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": {}
}
}

View File

@ -35,6 +35,11 @@ accessViewBack (l, ap) = (l, accessPositionBack (List.length l) ap)
accessViewDone : AccessView -> Bool
accessViewDone (_, ap) = accessPositionDone ap
finalCacheHierarchy : CacheHierarchy -> AccessView -> CacheHierarchy
finalCacheHierarchy ch (l, ap) =
List.map .output l ++ List.drop (List.length l) ch
effectiveCacheHierarchy : CacheHierarchy -> AccessView -> CacheHierarchy
effectiveCacheHierarchy c (l, ap) =
let

View File

@ -6,7 +6,7 @@ import CacheSim.AccessView exposing (..)
type alias Model =
{ rawHierarchy : RawCacheModelHierarchy
, hierarchy : Maybe CacheHierarchy
, accessView : Maybe AccessView
, accessView : Maybe (List AccessView)
, accessInput : String
}
type alias Flags = ()
@ -15,7 +15,7 @@ type Msg
| CreateRawModel
| DeleteRawModel Int
| UseHierarchy (Maybe CacheModelHierarchy)
| Access Int
| Access (List Int)
| ChangeAccessInput String
| AccessViewForward
| AccessViewBack

View File

@ -38,11 +38,19 @@ updateUseHierarchy cmh m =
in
(newModel, cmd)
updateAccess : Int -> Model -> (Model, Cmd Msg)
updateAccess i m =
updateAccess : List Int -> Model -> (Model, Cmd Msg)
updateAccess li m =
let
accessResult = Maybe.andThen (Result.toMaybe << accessCacheHierarchy i) m.hierarchy
newModel = { m | accessView = Maybe.map (\ar -> (ar, Down 0)) accessResult }
process c xs =
case xs of
[] -> Ok []
(i::t) ->
case accessCacheHierarchy i c of
Ok av -> Result.map ((::) (av, Down 0)) <| process (finalCacheHierarchy c (av, Done)) t
Err s -> Err s
accessResult = Maybe.andThen (\h -> Result.toMaybe <| process h li) m.hierarchy
newModel = { m | accessView = accessResult }
cmd = Cmd.none
in
(newModel, cmd)
@ -50,11 +58,11 @@ updateAccess i m =
updateAccessViewForward : Model -> (Model, Cmd Msg)
updateAccessViewForward m =
let
afterStep = Maybe.map accessViewForward m.accessView
replaceHierarchy avs h = List.map .output avs ++ List.drop (List.length avs) h
afterStep = Maybe.map (intMapUpdate 0 accessViewForward) m.accessView
(newHierarchy, newAccessView) =
case afterStep of
Just (avs, Done) -> (Maybe.map (replaceHierarchy avs) m.hierarchy, Nothing)
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 }
cmd = Cmd.none
@ -64,7 +72,7 @@ updateAccessViewForward m =
updateAccessViewBack : Model -> (Model, Cmd Msg)
updateAccessViewBack m =
let
afterStep = Maybe.map accessViewBack m.accessView
afterStep = Maybe.map (intMapUpdate 0 accessViewBack) m.accessView
newModel = { m | accessView = afterStep }
cmd = Cmd.none
in

View File

@ -4,6 +4,7 @@ import CacheSim.Model exposing (..)
import CacheSim.Cache exposing (..)
import CacheSim.AccessView exposing (..)
import CacheSim.Hierarchy exposing (..)
import Parser exposing ((|.))
import Html exposing (Html, Attribute, input, text, div, label, span, h2, h3, table, tr, td, th, p, h1)
import Html.Attributes exposing (type_, class, value, for, classList, disabled, colspan, hidden)
import Html.Events exposing (onInput, onClick)
@ -77,7 +78,7 @@ viewRawCacheModel level rcm =
deleteButton = dangerButton "Delete" (DeleteRawModel level)
params = div []
[ labeledInput "Block size" rcm.blockSize (wrapUpdate updateBlockSize)
[ labeledInput "Block size (words)" rcm.blockSize (wrapUpdate updateBlockSize)
, labeledInput "Set count" rcm.setCount (wrapUpdate updateSetCount)
, labeledInput "Set size" rcm.setSize (wrapUpdate updateSetSize)
]
@ -95,13 +96,17 @@ viewRawCacheModelHierarchy rcmh =
<| List.indexedMap viewRawCacheModel rcmh
translationResult = Result.andThen validateCacheModelHierarchy
<| translateRawCacheModelHierarchy rcmh
errorHtml =
checkedResult =
case translationResult of
Ok h -> if h == [] then Err "Please specify at least one cache level." else Ok h
Err e -> Err e
errorHtml =
case checkedResult of
Ok _ -> viewError True ""
Err e -> viewError False e
newButton = button "Add level" CreateRawModel
useButton = resultButton translationResult "Use hierarchy" (UseHierarchy << Just)
useButton = resultButton checkedResult "Use hierarchy" (UseHierarchy << Just)
in
div []
[ h2 [] [ text "Cache hierarchy" ]
@ -198,13 +203,34 @@ viewAccessLog (aes, ap) =
viewAccessInput : Model -> Html Msg
viewAccessInput m =
let
accessButton = maybeButton (String.toInt m.accessInput) "Access address" Access
parser =
Parser.map (List.map (\i -> i // 4)) <|
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
errorHtml =
case checkedResult of
Ok _ -> viewError True ""
Err e -> viewError False e
editHierarchyButton = button "Edit hierarchy" (UseHierarchy Nothing)
in
div []
[ h2 [] [ text "Run access simulation" ]
, labeledInput "Access address" m.accessInput ChangeAccessInput
, labeledInput "Access byte address" m.accessInput ChangeAccessInput
, buttonWrapper [ accessButton, editHierarchyButton ]
, errorHtml
]
viewDescription : Html Msg
@ -241,7 +267,15 @@ viewBase m =
Maybe.withDefault []
<| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy
Just _ -> []
accessView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewAccessView m) <| m.accessView
accessView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewAccessView m) <| Maybe.andThen (List.head) <| m.accessView
remainingAccessView =
case Maybe.map (\l -> List.length l - 1) m.accessView of
Just n -> if n <= 0 then [] else
[ div [ class "alert", class "alert-info" ] [ text <|
"Simulating more than one access. " ++ (String.fromInt n) ++
" addresses in queue." ]
]
_ -> []
in
div [ class "container" ]
<| [ viewDescription] ++ rawView ++ accessInputView ++ accessView ++ cacheView
<| [ viewDescription] ++ rawView ++ accessInputView ++ remainingAccessView ++ accessView ++ cacheView