[add Proxy support to vmap when computing with partial information.
John Meacham <john@repetae.net>**20060223061938] hunk ./Fixer/VMap.hs 1
-module Fixer.VMap where
+module Fixer.VMap(
+    VMap(),
+    Proxy(..),
+    vmapSingleton,
+    vmapArgSingleton,
+    vmapArg,
+    vmapValue,
+    vmapMember,
+    vmapProxyIndirect,
+    vmapPlaceholder,
+    vmapDropArgs,
+    vmapHeads
+    )where
+
+import Data.Monoid
+import Data.Typeable
+import List(intersperse)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
hunk ./Fixer/VMap.hs 23
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import Data.Typeable
-import Data.Monoid
hunk ./Fixer/VMap.hs 24
-import List(intersperse)
hunk ./Fixer/VMap.hs 28
-data VMap n = VMap {
-    vmapArgs :: (Map.Map (n,Int) (VMap n)),
-    vmapNodes :: (Set.Set n)
+data VMap p n = VMap {
+    vmapArgs    :: Map.Map (n,Int) (VMap p n),
+    vmapNodes   :: Set.Set (Either (Proxy p) n)
hunk ./Fixer/VMap.hs 34
-emptyVMap :: Ord a => VMap a
+-- A placeholder is either a placeholder, or an indirection of a placeholder.
+data Proxy p = Proxy p | ProxyArg (Proxy p) Int
+    deriving(Eq,Ord,Typeable)
+
+instance Show p => Show (Proxy p) where
+    showsPrec n (Proxy p) = showsPrec n p
+    showsPrec n (ProxyArg p i) = showsPrec n p .  (('-':show i) ++)
+
+emptyVMap :: (Ord a,Ord b) => VMap a b
hunk ./Fixer/VMap.hs 45
-vmapSingleton n = emptyVMap { vmapNodes = (Set.singleton n) }
+vmapSingleton n = emptyVMap { vmapNodes = Set.singleton (Right n) }
hunk ./Fixer/VMap.hs 49
-    | otherwise = emptyVMap { vmapArgs = (Map.singleton (n,i) v) }
+    | otherwise = emptyVMap { vmapArgs = Map.singleton (n,i) v }
+
+vmapArg n i vm@VMap { vmapArgs =  map } = case Map.lookup (n,i) map of
+    Just x -> x `lub` vmapProxyIndirect i vm
+    Nothing -> vmapProxyIndirect i vm
+
+vmapProxyIndirect :: (Ord n,Ord p) => Int -> VMap p n -> VMap p n
+vmapProxyIndirect i vm = emptyVMap {  vmapNodes = Set.fromList [  Left (ProxyArg p i) | Left p <- Set.toList $ vmapNodes vm] }
+
+vmapValue :: (Ord p,Ord n) => n -> [VMap p n] -> VMap p n
+vmapValue n xs = pruneVMap VMap { vmapArgs = Map.fromAscList (zip (zip (repeat n) [0..]) xs), vmapNodes = Set.singleton (Right n) }
+
+vmapPlaceholder :: (Ord p,Ord n) => p  -> VMap p n
+vmapPlaceholder p = emptyVMap { vmapNodes = Set.singleton $ Left (Proxy p) }
hunk ./Fixer/VMap.hs 64
-vmapArg n i VMap { vmapArgs =  map } = case Map.lookup (n,i) map of
-    Just x -> x
-    Nothing -> bottom
+vmapDropArgs vm = vm { vmapArgs = mempty }
hunk ./Fixer/VMap.hs 66
-vmapValue :: Ord n => n -> [VMap n] -> VMap n
-vmapValue n xs = pruneVMap VMap { vmapArgs = Map.fromAscList (zip (zip (repeat n) [0..]) xs), vmapNodes = Set.singleton n }
+vmapHeads VMap { vmapNodes = set }
+    | any isLeft (Set.toList set) = fail "vmapHeads: VMap has a placeholder"
+    | otherwise = return $ rights $ Set.toList set
+vmapMember n VMap { vmapNodes = set } = Right n `Set.member` set || any isLeft (Set.toList set)
hunk ./Fixer/VMap.hs 71
-vmapHeads VMap { vmapNodes = set } = Set.toList set
-vmapJustHeads VMap { vmapNodes = set } = emptyVMap { vmapNodes = set }
hunk ./Fixer/VMap.hs 76
-instance (Ord n,Show n) => Show (VMap n) where
-    showsPrec _ (VMap n s) = braces (hcat (intersperse (char ',') $ (map f $ snub $ fsts  (Map.keys n) ++ Set.toList s) )) where
+instance (Ord p,Ord n,Show p,Show n) => Show (VMap p n) where
+    showsPrec _ VMap { vmapArgs = n, vmapNodes = s } = braces (hcat (intersperse (char ',') $ (map f $ snub $ (map Right $ fsts $ Map.keys n) ++ Set.toList s) )) where
hunk ./Fixer/VMap.hs 79
-        g a = sortUnder fst [ (i,v) | ((a',i),v) <- Map.toList n, a' == a ]
+        g a = sortUnder fst [ (i,v) | ((a',i),v) <- Map.toList n, Right a' == a ]
hunk ./Fixer/VMap.hs 81
-instance Ord n => Fixable (VMap n) where
+instance (Ord p,Ord n) => Fixable (VMap p n) where
hunk ./Fixer/VMap.hs 91
-instance Ord n => Monoid (VMap n) where
+instance (Ord p,Ord n) => Monoid (VMap p n) where