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

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