From 25d6ecc7690abf3aa644f97b9aa9596b9f2202e7 Mon Sep 17 00:00:00 2001
From: Danila Fedorin <danila.fedorin@gmail.com>
Date: Tue, 28 May 2019 21:01:35 -0700
Subject: [PATCH] Display headers for caches.

---
 src/CacheSim/Raw.elm  |  2 +-
 src/CacheSim/View.elm | 53 +++++++++++++++++++++++++++++++++++++++----
 2 files changed, 50 insertions(+), 5 deletions(-)

diff --git a/src/CacheSim/Raw.elm b/src/CacheSim/Raw.elm
index 8084f7f..bea9920 100644
--- a/src/CacheSim/Raw.elm
+++ b/src/CacheSim/Raw.elm
@@ -43,7 +43,7 @@ validateCacheModelHierarchy cmh =
         x::[] -> Ok [x]
         x::y::xs ->
             if modBy x.blockSize y.blockSize == 0
-            then validateCacheModelHierarchy (y::xs)
+            then Result.map ((::) x) <| validateCacheModelHierarchy (y::xs)
             else Err <| "Block cache size " ++ String.fromInt y.blockSize ++
                 " is not a multiple of the next level cache's" ++
                 " block size (" ++ String.fromInt x.blockSize ++ ")"
diff --git a/src/CacheSim/View.elm b/src/CacheSim/View.elm
index bed1316..a1f828a 100644
--- a/src/CacheSim/View.elm
+++ b/src/CacheSim/View.elm
@@ -1,8 +1,10 @@
 module CacheSim.View exposing (..)
 import CacheSim.Raw exposing (..)
 import CacheSim.Model exposing (..)
-import Html exposing (Html, input, text, div, label, span, h2, h3)
-import Html.Attributes exposing (type_, class, value, for, classList, disabled)
+import CacheSim.Cache exposing (..)
+import CacheSim.Hierarchy exposing (..)
+import Html exposing (Html, input, text, div, label, span, h2, h3, table, tr, td)
+import Html.Attributes exposing (type_, class, value, for, classList, disabled, colspan)
 import Html.Events exposing (onInput, onClick)
 
 optionalButton : Bool -> String -> Msg -> Html Msg
@@ -51,7 +53,7 @@ viewRawCacheModelHierarchy : RawCacheModelHierarchy -> Html Msg
 viewRawCacheModelHierarchy rcmh =
     let
         models = div [ class "cache-model-levels" ] 
-            <|List.indexedMap viewRawCacheModel rcmh
+            <| List.indexedMap viewRawCacheModel rcmh
         translationResult = Result.andThen validateCacheModelHierarchy
             <| translateRawCacheModelHierarchy rcmh
         isValid =
@@ -75,9 +77,52 @@ viewRawCacheModelHierarchy rcmh =
             , models
             ]
 
+viewCache : Int -> Cache -> Html Msg
+viewCache level (cm, cs) =
+    let
+        slotLabels =
+            List.indexedMap (\i _ -> td [] [ text <| String.fromInt i ])
+            <| List.repeat cm.setSize ()
+        slotLabel = td [ colspan cm.setSize ] [ text "Slot" ]
+        allSlotLabels = List.concat <| List.repeat cm.setCount slotLabels
+        allSlotsLabel = List.repeat cm.setCount slotLabel
+
+        setLabels =
+            List.indexedMap (\i _ -> td [ colspan cm.setSize ] [ text <| String.fromInt i ])
+            <| List.repeat cm.setCount ()
+        setLabel = [ td [ colspan <| cm.setSize * cm.setCount ] [ text "Set" ] ]
+        cacheTable =
+            table []
+                [ tr [ classList [("hidden", cm.setCount == 1)] ] setLabel
+                , tr [ classList [("hidden", cm.setCount == 1)] ] setLabels
+                , tr [ classList [("hidden", cm.setSize == 1)] ] allSlotsLabel
+                , tr [ classList [("hidden", cm.setSize == 1)] ] allSlotLabels
+                ]
+    in
+        div [ class "cache" ]
+            [ h3 [] [ text <| "L" ++ String.fromInt level ++ " Cache" ]
+            , cacheTable
+            ]
+
+viewCacheHierarchy : CacheHierarchy -> Html Msg
+viewCacheHierarchy ch =
+    let
+        levels = div [ class "cache-levels" ] 
+            <| List.indexedMap viewCache ch
+    in
+    div [ class "cache-hierarchy" ] <|
+        [ h2 [] [ text <| "Cache hierarchy" ]
+        , levels
+        ]
+        
+
 viewError : Bool -> String -> Html Msg
 viewError hide e = span [ classList [ ("hidden", hide) ] ] [ text e ]
 
 viewBase : Model -> Html Msg
 viewBase m =
-    div [] [ viewRawCacheModelHierarchy m.rawHierarchy ]
+    let
+        rawView = viewRawCacheModelHierarchy m.rawHierarchy
+        cacheView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy
+    in
+        div [] <| [ rawView ] ++ cacheView