[<<][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.

What about something like this:

     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][>>][..]