Allow accessing several numbers.

This commit is contained in:
Danila Fedorin 2019-05-29 23:48:02 -07:00
parent b96c16918b
commit 281c589dc6
5 changed files with 66 additions and 12 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 : AccessView -> Bool
accessViewDone (_, ap) = accessPositionDone ap 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 : CacheHierarchy -> AccessView -> CacheHierarchy
effectiveCacheHierarchy c (l, ap) = effectiveCacheHierarchy c (l, ap) =
let let

View File

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

View File

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

View File

@ -4,6 +4,7 @@ import CacheSim.Model exposing (..)
import CacheSim.Cache exposing (..) import CacheSim.Cache exposing (..)
import CacheSim.AccessView exposing (..) import CacheSim.AccessView exposing (..)
import CacheSim.Hierarchy 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 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.Attributes exposing (type_, class, value, for, classList, disabled, colspan, hidden)
import Html.Events exposing (onInput, onClick) import Html.Events exposing (onInput, onClick)
@ -198,13 +199,28 @@ viewAccessLog (aes, ap) =
viewAccessInput : Model -> Html Msg viewAccessInput : Model -> Html Msg
viewAccessInput m = viewAccessInput m =
let let
accessButton = maybeButton (String.toInt m.accessInput) "Access address" Access parser =
Parser.sequence
{ start = ""
, end = ""
, separator = ","
, spaces = Parser.spaces
, item = Parser.int
, trailing = Parser.Optional
}
parseResult = Parser.run (parser |. Parser.end) m.accessInput
accessButton = maybeButton (Result.toMaybe parseResult) "Access address" Access
errorHtml =
case parseResult of
Ok _ -> viewError True ""
Err lde -> viewError False "Unable to parse input. Please enter a sequence of numbers separated by commas."
editHierarchyButton = button "Edit hierarchy" (UseHierarchy Nothing) editHierarchyButton = button "Edit hierarchy" (UseHierarchy Nothing)
in in
div [] div []
[ h2 [] [ text "Run access simulation" ] [ h2 [] [ text "Run access simulation" ]
, labeledInput "Access address" m.accessInput ChangeAccessInput , labeledInput "Access address" m.accessInput ChangeAccessInput
, buttonWrapper [ accessButton, editHierarchyButton ] , buttonWrapper [ accessButton, editHierarchyButton ]
, errorHtml
] ]
viewDescription : Html Msg viewDescription : Html Msg
@ -241,7 +257,7 @@ viewBase m =
Maybe.withDefault [] Maybe.withDefault []
<| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy <| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy
Just _ -> [] 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
in in
div [ class "container" ] div [ class "container" ]
<| [ viewDescription] ++ rawView ++ accessInputView ++ accessView ++ cacheView <| [ viewDescription] ++ rawView ++ accessInputView ++ accessView ++ cacheView