[improve type analysis. use generice VMap
John Meacham <john@repetae.net>**20051011231409] hunk ./E/TypeAnalysis.hs 24
-data Typ = L (Map.Map Name [Typ]) (Set.Set Name)
-    deriving(Show,Typeable,Eq,Ord)
-
-
-instance Fixable Typ where
-    bottom = L Map.empty Set.empty
-    isBottom (L map set) = Set.null set && Map.null map
-    lub (L as ns) (L as' ns') = pruneTyp $ L (Map.unionWith (zipWith lub) as as') (Set.union ns ns')
-    minus (L n1 w1) (L n2 w2) = pruneTyp $ L (Map.fromList $ [
-            case Map.lookup n n2 of
-                Just vs ->  (n,[ a `minus` v | v <- vs | a <- as ])
-                Nothing ->  (n,as)
-        | (n,as) <- Map.toList n1 ] ) (w1 Set.\\ w2)
hunk ./E/TypeAnalysis.hs 25
-pruneTyp (L map set) = L map' set where
-    map' = Map.filter f map
-    f vs = any (not . isBottom) vs
+type Typ = VMap Name
hunk ./E/TypeAnalysis.hs 42
-    ds <- annotateDs mempty lambind lambind lambind ds
+    ds <- annotateDs mempty lambind (\_ -> return) (\_ -> return) ds
hunk ./E/TypeAnalysis.hs 57
-        t' `isSuperSetOf` (value $ L mempty (Set.singleton n))
+            v = vmapSingleton n
+        t' `isSuperSetOf` (value v)
hunk ./E/TypeAnalysis.hs 60
-        flip mapM_ [0.. length xs' - 1]  $ \i -> do
-            modifiedSuperSetOf t' (xs' !! i) $ \v ->
-                L (Map.singleton n [ if x == i then v else bottom | x <- [0 .. length xs' - 1]]) Set.empty
-                {-
+        flip mapM_ (zip xs' [0.. ])  $ \ (v,i) -> do
+            modifiedSuperSetOf t' v (vmapArgSingleton n i)
hunk ./E/TypeAnalysis.hs 66
-        dynamicRule v' $ \ (L mp st) -> do
-            flip mapM_ (Set.toList st) $ \n -> do
-                undefined
-        flip mapM_ [0.. length xs' - 1]  $ \i -> do
-            modifiedSuperSetOf t' (xs' !! i) $ \v ->
-                L (Map.singleton n [ if x == i then v else bottom | x <- [0 .. length xs' - 1]]) Set.empty
-
--}
-
+        dynamicRule v' $ \ v -> flip mapM_ (vmapHeads v) $ \ h -> do
+            t' `isSuperSetOf` value (vmapSingleton h)
+            flip mapM_ (zip as' [0.. ])  $ \ (a,i) -> do
+                modifiedSuperSetOf t' a $ \ v -> vmapArgSingleton h i v
hunk ./E/TypeAnalysis.hs 73
+    calcE env e
hunk ./E/TypeAnalysis.hs 76
-        modifiedSuperSetOf t' v (\ (L map _) -> case Map.lookup n map of
-            Just xs -> xs !! i
-            Nothing -> bottom
-            )
-
-
+        modifiedSuperSetOf t' v (vmapArg n i)
hunk ./E/TypeAnalysis.hs 97
-calcE _ EAp {} = return ()
hunk ./E/TypeAnalysis.hs 103
+calcE _ EAp {} = return ()
hunk ./E/TypeAnalysis.hs 114
+typConstant :: Monad m => E -> m Typ
hunk ./E/TypeAnalysis.hs 117
-    return $  L (Map.singleton n xs') (Set.singleton n)
+    return $ vmapValue n xs'
hunk ./E/TypeAnalysis.hs 127
+
+vmapArgSingleton n i v
+    | isBottom v = bottom
+    | otherwise = VMap (Map.singleton (n,i) v) Set.empty
+
+vmapArg n i (VMap map _) = case Map.lookup (n,i) map of
+    Just x -> x
+    Nothing -> bottom
+
+vmapValue :: Ord n => n -> [VMap n] -> VMap n
+vmapValue n xs = pruneVMap $ VMap (Map.fromAscList (zip (zip (repeat n) [0..]) xs)) (Set.singleton n)
+
+vmapHeads (VMap _ set) = Set.toList set
+vmapJustHeads (VMap _ set) = VMap Map.empty set