--------------------------------------------------------------------------------
--                                                                            --
-- Heap code                                                                  --
--                                                                            --
--------------------------------------------------------------------------------

type Store x = [(Loc,x)]
type Heap x = (Loc, Store x)

instance Initial (Heap x) where
  initial = (0,[])

allocH :: Heap (m v) -> Heap (m v)
allocH (bound,store) = (bound+1,store)

lookupHerr1 loc = err ("lookupH : loc " ++ show loc ++ " out of bounds")
lookupHerr2 loc = err ("lookupH : loc " ++ show loc ++ " not bound")

lookupH :: ErrMonad m => Loc -> Heap (m v) -> m v
lookupH loc (bound,store) = if (loc < 0 || loc >= bound) 
	                     then lookupHerr1 loc
		             else lookup loc store 
                           where
		            lookup l ((l',m):s) = if l == l' 
                                     then m 
                                     else lookup l s
		            lookup l _ = lookupHerr2 l

updateHerr loc = err ("updateH : loc " ++ show loc ++ " out of bounds")

updateH :: StateMonad (Heap (m v)) m 
          => (Loc,m v) -> Heap (m v) -> m (Heap (m v))
updateH (loc,m) (bound,store)
   = if (loc < 0 || loc >= bound) 
      then updateHerr loc
      else act (\(bound,store) -> (bound,((loc,m):store)))

allocHeap :: StateMonad (Heap (m v)) m => m (Heap (m v))
allocHeap = act allocH

lookupHeap :: StateMonad (Heap (m v)) m => Loc -> m v
lookupHeap loc = do 
                  heap <- act id
                  lookupH loc heap

updateHeap :: StateMonad (Heap (m v)) m 
             => (Heap (m v),m v) -> m (Heap (m v))
updateHeap ((loc,_),m) = do
                          heap <- act id
                          updateH (loc,m) heap

--------------------------------------------------------------------------------







