`[<<][meta][>>][..]`
Sun Feb 14 10:27:38 CET 2010

## Term -> Closure Term Env

```
-- A Closure represents a Term and its environment Env.  An
-- environment is a set of nodes and an association
-- (membership/sharing) function.

type Member a  = Term a -> Maybe (Term a)
data Env a     = Env [Term a] (Member a)
data Closure a = Closure {closureTerm :: Term a, closureEnv :: Env a }

instance Show a => Show (Closure a) where
show (Closure t (Env ts _)) = show (t,ts)

-- To extend an environment with a Term is to either establish its
-- membership and return a representative, or to add it to the set and
-- membership functions.

extend t e@(Env ts member) =
case (member t) of
Just t' -> Closure t' e
Nothing -> Closure t (Env (t:ts) (compareTerm member t))

compareTerm :: Eq a => Member a -> Term a -> Member a
compareTerm = compareTermModulo (==)
noMember t  = Nothing

compareTermModulo eq member t = f where
f t' | t `eq` t'  = Just t
f t' | otherwise  = member t'

returnClosure t = Closure t (Env [t] (compareTerm noMember t))

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

However, the member function doesn't need to be made so abstract:
eventually this should only catch equivalences that are not captured
by the the pointer equality.

Env [Term a] [(Term a, Term a)]

where the first list is the list of shared nodes, and the finite
function caches other equivalences.  Whenever a comparison doesn't
match, it is added to the list of nodes.

Ok, this seems to work:

data Env a     = Env [(Term a)] [(Term a, Term a)]
data Closure a = Closure {closureTerm :: Term a, closureEnv :: Env a }

instance Show a => Show (Closure a) where
show (Closure t (Env ts eqs)) = show (t,ts,eqs)

ptrEqual :: a -> a -> IO Bool
ptrEqual a b = do
a' <- makeStableName a
b' <- makeStableName b
return (a' == b')

termRefEq :: (Eq a) => (Term a) -> (Term a) -> Bool
termRefEq x y = unsafePerformIO \$ ptrEqual x y

firstWith p = f where
f []           = Nothing
f (x:xs) | p x = Just x
f (_:xs)       = f xs

lookupWith p = f where
f []               = Nothing
f ((a,b):ps) | p a = Just b
f (_:ps)           = f ps

-- To extend an environment with a Term is to either establish its
-- membership and return a representative, or to add it to the node
-- set or equivalence tables.

extend :: Eq a => Term a -> Env a -> Closure a
extend t e@(Env ts eqs) = find cache0 (find cache1 miss)
where
cache0 = firstWith  (t `termRefEq`) ts      -- try exact== node table
cache1 = lookupWith (t `termRefEq`) eqs     -- try equivalence== memo table
miss = case firstWith (t ==) ts of          -- compute real equivalence
Just t' -> Closure t' (Env ts ((t,t'):eqs))  -- extend memo table
Nothing -> Closure t  (Env (t:ts) eqs)       -- extend node table

find cache next = case cache of
Just t' -> Closure t' e; -- reuse from cache
Nothing -> next          -- try next search

```
`[Reply][About]`
`[<<][meta][>>][..]`