$Id: Stores.lhs,v 1.5 2004/10/18 23:47:48 leavens Exp leavens $ Stores as in David A. Schmidt's "The Structure of Typed Programming Languages" (MIT Press, 1994). > module Stores(Storable, Location, > Store, lookup_with_default, > lookup, update, emptyStore, allocate) where > import Prelude hiding(lookup) > import List(genericLength, genericTake, genericDrop) --in the Haskell library The assumptions about storable values are captured in the class Storable. > class Storable t where > defaultContents :: t Locations Locations are positive integers. > type Location = Integer -- note a difference from the book There are no operations on locations. In this implementation, stores are lists with 1-based indexing. That is, the first element of the list is the element at index 1 in the store. > type Store storable = [storable] > -- Operations: > lookup_with_default :: storable -> Integer -> Store storable -> storable > lookup_with_default def_val j s > | (0 < j) && (j <= genericLength s) = s !! (fromInteger (j-1)) > | otherwise = def_val > lookup :: Storable storable => > (Integer, Store storable) -> storable > lookup(j, s) = lookup_with_default defaultContents j s > update :: (Integer, storable, Store storable) -> Store storable > update(j, n, s) > | (0 < j) && (j <= genericLength s) = > (genericTake (j-1) s) ++ [n] ++ (genericDrop j s) > | otherwise = s > -- if is already in Haskell Note: we need to use genericLength because j is a Haskell Integer, and length returns a Haskell Int (:-|) > emptyStore :: Store storable > emptyStore = [] > allocate :: Storable storable => > Store storable -> (Integer, Store storable) > allocate s = > let ([l], news) = allocateAndInit [defaultContents] s > in (l, news) > allocateAndInit :: [storable] > -> Store storable -> ([Integer], Store storable) > allocateAndInit vals s = > let len = genericLength s > locs = [(len+1) .. (len + genericLength vals)] > news = s ++ vals > in (locs, news) The following are used in chapter 4 > sizeOf :: Store storable -> Integer > sizeOf = genericLength > free :: Integer -> Store storable -> Store storable > free = genericTake