summaryrefslogtreecommitdiff
path: root/hs/GCStore.hs
blob: d1e550f31f7d23144afe128193a742df7b31c1e7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
-- Intended to be imported qualified.

module GCStore(Store, Id, empty, store, retrieve, update, refcount, ref, deref) where

import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

-- import Debug.Trace


type Id = Int

data Store a = Store (Map.Map Id (a, Int)) (Set.Set Id) (Set.Set Id)
  deriving (Show)

empty :: Store a
empty = Store Map.empty Set.empty Set.empty

store :: Show a => Store a -> a -> (Id, Store a)
store (Store vm fs us) a =
    let (i, fs') = if Set.null fs
                       then (maybe 1 succ (Set.lookupMax us), fs)
                       else Set.deleteFindMin fs
    in (i, Store (Map.insert i (a, 1) vm) fs' (Set.insert i us))

retrieve :: Store a -> Id -> Maybe a
retrieve (Store vm _ _) i = fst <$> Map.lookup i vm

update :: Show a => Store a -> Id -> a -> Store a
update (Store vm fs us) i a =
    maybe (error $ "GCStore.update on nonexistent id " ++ show i)
          (\(_, rc) -> Store (Map.insert i (a, rc) vm) fs us)
          (Map.lookup i vm)

refcount :: Store a -> Id -> Int
refcount (Store vm _ _) i = maybe 0 snd $ Map.lookup i vm

ref :: Store a -> Id -> Store a
ref (Store vm fs us) i = Store (Map.alter updf i vm) fs us
  where updf Nothing = error $ "GCStore.ref on nonexistent id " ++ show i
        updf (Just (a, rc)) = Just (a, rc + 1)

deref :: Store a -> Id -> Store a
deref (Store vm fs us) i =
    maybe (error $ "GCStore.deref on nonexistent id " ++ show i)
          (\(a, rc) -> if rc == 1
              then Store (Map.delete i vm) (Set.insert i fs) (Set.delete i us)
              else Store (Map.insert i (a, rc - 1) vm) fs us)
          (Map.lookup i vm)