module CacheSim.Cache exposing (..)
import CacheSim.IntMap exposing (..)

-- Types that help document code
type alias Lru = Int
type alias WordAddr = Int
type alias BlockAddr = Int
type alias BlockSize = Int
type alias SetCount = Int
type alias SetSize = Int

-- Cache description, without state
type alias CacheModel = 
    { blockSize : BlockSize
    , setCount : SetCount
    , setSize : SetSize
    }

-- Types for cache state
type CacheSlot = Empty | Used Lru BlockAddr 
type alias CacheSet = IntMap CacheSlot
type alias CacheState = IntMap CacheSet

type alias Cache = (CacheModel, CacheState)

type AccessResult = Hit | Miss
type alias AccessEffect a =
    { result : AccessResult
    , output : a
    }


fullyAssociativeCache : BlockSize -> SetSize -> CacheModel
fullyAssociativeCache bs ss =
    { blockSize = bs
    , setCount = 1
    , setSize = ss
    }

directMappedCache : BlockSize -> SetCount -> CacheModel
directMappedCache bs sc =
    { blockSize = bs
    , setCount = sc
    , setSize = 1
    }

findExistingSlot : BlockAddr -> CacheSet -> Maybe Int
findExistingSlot ba =
    let
        isExisting cs =
            case cs of
                Empty -> False
                Used l aba -> ba == aba
    in
        intMapFind isExisting 

findEmptySlot : CacheSet -> Maybe Int
findEmptySlot =
    let
        isEmpty cs =
            case cs of
                Empty -> True
                _ -> False
    in
        intMapFind isEmpty

findLruSlot : CacheSet -> Maybe Int
findLruSlot cs =
    let
        minLru = List.minimum <| List.map cacheSlotLru cs
        isMin s = Just (cacheSlotLru s) == minLru
    in
        intMapFind isMin cs

cacheSlotLru : CacheSlot -> Lru
cacheSlotLru c =
    case c of
        Empty -> -1
        Used l _ -> l

cacheSlotSetLru : Int -> CacheSlot -> CacheSlot
cacheSlotSetLru i c =
    case c of
        Empty -> Empty
        Used _ v -> Used i v

cacheSlotBumpLru : CacheSlot -> CacheSlot
cacheSlotBumpLru c =
    case c of
        Empty -> Empty
        Used l v -> Used (l+1) v

cacheSetBumpLru : CacheSet -> CacheSet
cacheSetBumpLru = List.map cacheSlotBumpLru

accessCacheSet : CacheModel -> BlockAddr -> CacheSet -> Result String (AccessEffect CacheSet)
accessCacheSet cm ba cs =
    let
        existingSlotEffect =
            case findExistingSlot ba cs of
                Just i -> Ok { result = Hit, output = intMapUpdate i (cacheSlotSetLru 0) <| cacheSetBumpLru cs }
                Nothing -> emptySlotEffect
        emptySlotEffect =
            case findEmptySlot cs of
                Just i -> Ok { result = Miss, output = intMapPut i (Used 0 ba) <| cacheSetBumpLru cs }
                Nothing -> lruSlotEffect
        lruSlotEffect =
            case findLruSlot cs of
                Just i -> Ok { result = Miss, output = intMapPut i (Used 0 ba) <| cacheSetBumpLru cs }
                Nothing -> Err "Unable to find a single spot in the cache set. Is the size nonzero?"
    in
        existingSlotEffect

accessCache : WordAddr -> Cache -> Result String (AccessEffect Cache)
accessCache wa c =
    let
        (cm, cs) = c
        blockAddr = wa // cm.blockSize
        setAddr = modBy cm.setCount blockAddr 
        set = intMapGet setAddr cs
        setAccess = Maybe.map (accessCacheSet cm blockAddr) set
        transformAccess { result, output } =
            { result = result
            , output = (cm, intMapPut setAddr output cs)
            }
    in
        case setAccess of
            Just (Ok ar) -> Ok <| transformAccess ar
            Just (Err e) -> Err <| "Error accessing cache set: " ++ e
            Nothing -> Err "Unable to find correct set in cache."