[move Fixer related code to own directory. make Rules have a different type than IO actions
John Meacham <john@repetae.net>**20060125011603] adddir ./Fixer
move ./Fixer.hs ./Fixer/Fixer.hs
hunk ./E/TypeAnalysis.hs 20
-import Fixer
+import Fixer.Fixer
hunk ./E/TypeAnalysis.hs 59
-        conditionalRule (v `Set.member`) usedVals (calcE env e)
+        addRule $ conditionalRule (v `Set.member`) usedVals (ioToRule $ calcE env e)
hunk ./E/TypeAnalysis.hs 65
-        t' `isSuperSetOf` v
+        addRule $ t' `isSuperSetOf` v
hunk ./E/TypeAnalysis.hs 69
-        t' `isSuperSetOf` (value v)
+        addRule $ t' `isSuperSetOf` (value v)
hunk ./E/TypeAnalysis.hs 72
-            modifiedSuperSetOf t' v (vmapArgSingleton n i)
+            addRule $ modifiedSuperSetOf t' v (vmapArgSingleton n i)
hunk ./E/TypeAnalysis.hs 77
-        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
+        addRule $ dynamicRule v' $ \ v -> mconcat $ flip map (vmapHeads v) $ \ h -> 
+            mconcat $ t' `isSuperSetOf` value (vmapSingleton h) : (flip map (zip as' [0.. ])  $ \ (a,i) -> modifiedSuperSetOf t' a $ \ v -> vmapArgSingleton h i v)
hunk ./E/TypeAnalysis.hs 83
-    conditionalRule (\ (VMap _ vs) -> n `Set.member` vs) v $ do
+    addRule $ conditionalRule (\ (VMap _ vs) -> n `Set.member` vs) v $ ioToRule $ do
hunk ./E/TypeAnalysis.hs 87
-            modifiedSuperSetOf t' v (vmapArg n i)
+            addRule $ modifiedSuperSetOf t' v (vmapArg n i)
hunk ./E/TypeAnalysis.hs 112
-            t `isSuperSetOf` a'
+            addRule $ t `isSuperSetOf` a'
hunk ./E/TypeAnalysis.hs 117
-tagE (usedVals,_) (EVar v) = usedVals `isSuperSetOf` value (Set.singleton v)
+tagE (usedVals,_) (EVar v) = addRule $ usedVals `isSuperSetOf` value (Set.singleton v)
hunk ./Fixer/Fixer.hs 4
-module Fixer(
+module Fixer.Fixer(
hunk ./Fixer/Fixer.hs 7
-    newValue,
+    Rule,
+    addRule,
+    ioToRule,
+    conditionalRule,
+    dynamicRule,
hunk ./Fixer/Fixer.hs 13
-    readValue,
hunk ./Fixer/Fixer.hs 14
-    value,
hunk ./Fixer/Fixer.hs 16
-    conditionalRule,
-    dynamicRule
+    newValue,
+    readValue,
+    value
hunk ./Fixer/Fixer.hs 22
+import Data.Monoid
hunk ./Fixer/Fixer.hs 37
-type Rules = IO ()
hunk ./Fixer/Fixer.hs 50
+newtype Rule = Rule { unRule :: IO () }
+    deriving(Typeable)
+
+instance Monoid Rule where
+    mempty = Rule (return ())
+    mappend (Rule a) (Rule b) = Rule (a >> b)
+    mconcat rs = Rule $ sequence_ $ map unRule rs
+
hunk ./Fixer/Fixer.hs 107
+-- | add a rule to the current set
+addRule :: Rule -> IO ()
+addRule (Rule act) = act
hunk ./Fixer/Fixer.hs 111
+-- | turn an IO action into a Rule
+ioToRule :: IO () -> Rule
+ioToRule act = Rule act
hunk ./Fixer/Fixer.hs 117
-modifiedSuperSetOf :: (Fixable a, Fixable b) =>  Value b -> Value a -> (a -> b) -> IO ()
-modifiedSuperSetOf (IV rv) (ConstValue cv) r = propagateValue (r cv) rv
-modifiedSuperSetOf (IV rv) v2 r = addAction v2 (\x -> propagateValue (r x) rv)
-modifiedSuperSetOf ConstValue {} _ _ =  fail "Fixer: You cannot modify a constant value"
+modifiedSuperSetOf :: (Fixable a, Fixable b) =>  Value b -> Value a -> (a -> b) -> Rule
+modifiedSuperSetOf (IV rv) (ConstValue cv) r = Rule $ propagateValue (r cv) rv
+modifiedSuperSetOf (IV rv) v2 r = Rule $ addAction v2 (\x -> propagateValue (r x) rv)
+modifiedSuperSetOf ConstValue {} _ _ =  Rule $ fail "Fixer: You cannot modify a constant value"
hunk ./Fixer/Fixer.hs 122
-isSuperSetOf :: Fixable a => Value a -> Value a -> IO ()
-(IV rv) `isSuperSetOf` (ConstValue v2) = propagateValue v2 rv
-(IV rv) `isSuperSetOf` v2 = addAction v2 (\x -> propagateValue x rv)
-ConstValue {} `isSuperSetOf` _ =   fail "Fixer: You cannot modify a constant value"
+isSuperSetOf :: Fixable a => Value a -> Value a -> Rule
+(IV rv) `isSuperSetOf` (ConstValue v2) = Rule $ propagateValue v2 rv
+(IV rv) `isSuperSetOf` v2 = Rule $ addAction v2 (\x -> propagateValue x rv)
+ConstValue {} `isSuperSetOf` _ = Rule $  fail "Fixer: You cannot modify a constant value"
hunk ./Fixer/Fixer.hs 128
-conditionalRule :: Fixable a => (a -> Bool) -> Value a -> Rules -> IO ()
-conditionalRule cond v act = addAction v (\x -> if cond x then act else return ())
+conditionalRule :: Fixable a => (a -> Bool) -> Value a -> Rule -> Rule
+conditionalRule cond v (Rule act) = Rule $ addAction v (\x -> if cond x then act else return ())
hunk ./Fixer/Fixer.hs 131
-dynamicRule  :: Fixable a =>  Value a -> (a -> Rules) -> IO ()
-dynamicRule v dr = addAction v dr
+dynamicRule  :: Fixable a =>  Value a -> (a -> Rule) -> Rule
+dynamicRule v dr = Rule $ addAction v (unRule . dr)
hunk ./Grin/PointsToAnalysis.hs 18
-import Fixer
+import Fixer.Fixer
hunk ./Grin/PointsToAnalysis.hs 378
-        docase _ _ _ = error $ "docase: strange argument"
+        --docase _ _ _ = error $ "docase: strange argument"
hunk ./Grin/PointsToAnalysis.hs 534
-            pp p | Just c <- constPos p = self `isSuperSetOf` value c
-            pp p | Just e <- simplePos p = self `isSuperSetOf` e
+            pp p | Just c <- constPos p = addRule $ self `isSuperSetOf` value c
+            pp p | Just e <- simplePos p = addRule $ self `isSuperSetOf` e
hunk ./Grin/PointsToAnalysis.hs 542
-                conditionalRule (Set.member a . getNodes) p' $ do self `isSuperSetOf` t'
+                addRule $ conditionalRule (Set.member a . getNodes) p' $  self `isSuperSetOf` t'
hunk ./Grin/PointsToAnalysis.hs 548
-                    conditionalRule (Set.member a . getNodes) p' $ do self `isSuperSetOf` w'
+                    addRule $ conditionalRule (Set.member a . getNodes) p' $  self `isSuperSetOf` w'
hunk ./Grin/PointsToAnalysis.hs 550
-                conditionalRule (\x -> not $ or [ Set.member a (getNodes x) | (a,_) <- vs]) p' $ do runOnce once (self `isSuperSetOf` e')
+                addRule $ conditionalRule (\x -> not $ or [ Set.member a (getNodes x) | (a,_) <- vs]) p' $ ioToRule $  runOnce once (addRule $ self `isSuperSetOf` e')
hunk ./Grin/PointsToAnalysis.hs 554
-                    modifiedSuperSetOf self p' (\n -> pruneNodes $ VsNodes (Map.filterWithKey (\ (t,_) _ -> tagIsWHNF t) (getNodeArgs n)) (Set.filter tagIsWHNF (getNodes n)))
-                    dynamicRule p' $ \p -> do
+                    addRule $ modifiedSuperSetOf self p' (\n -> pruneNodes $ VsNodes (Map.filterWithKey (\ (t,_) _ -> tagIsWHNF t) (getNodeArgs n)) (Set.filter tagIsWHNF (getNodes n)))
+                    addRule $ dynamicRule p' $ \p -> ioToRule $ do
hunk ./Grin/PointsToAnalysis.hs 559
-                                a `isSuperSetOf` value v
+                                addRule $ a `isSuperSetOf` value v
hunk ./Grin/PointsToAnalysis.hs 562
-                    dynamicRule p' $ \v -> flip mapM_ (Set.toList (getHeaps' ("funcFetch" ++ show cc) v)) $ \u -> do
+                    addRule $ dynamicRule p' $ \v -> mconcat $ flip map (Set.toList (getHeaps' ("funcFetch" ++ show cc) v)) $ \u -> ioToRule $ do
hunk ./Grin/PointsToAnalysis.hs 564
-                            Just (x,_) -> self `isSuperSetOf` x
+                            Just (x,_) -> addRule $ self `isSuperSetOf` x
hunk ./Grin/PointsToAnalysis.hs 567
-                                self `isSuperSetOf` value z
+                                addRule $ self `isSuperSetOf` value z
hunk ./Grin/PointsToAnalysis.hs 571
-                modifiedSuperSetOf self v' $ \v -> let
+                addRule $ modifiedSuperSetOf self v' $ \v -> let
hunk ./Grin/PointsToAnalysis.hs 576
-                dynamicRule v' $ \v -> do
+                addRule $ dynamicRule v' $ \v -> ioToRule $ do
hunk ./Grin/PointsToAnalysis.hs 581
-                        modifiedSuperSetOf self x' $ \x ->
+                        addRule $ modifiedSuperSetOf self x' $ \x ->
hunk ./Grin/PointsToAnalysis.hs 586
-                            Just (1,fn) -> self `isSuperSetOf` (fst $ runIdentity $ Map.lookup fn funcMap)
+                            Just (1,fn) -> addRule $ self `isSuperSetOf` (fst $ runIdentity $ Map.lookup fn funcMap)
hunk ./Grin/PointsToAnalysis.hs 591
-                modifiedSuperSetOf self p' $ \p -> case Map.lookup (a,i) (getNodeArgs p) of
+                addRule $ modifiedSuperSetOf self p' $ \p -> case Map.lookup (a,i) (getNodeArgs p) of
hunk ./Grin/PointsToAnalysis.hs 596
-                self `isSuperSetOf` x
+                addRule $ self `isSuperSetOf` x
hunk ./Grin/PointsToAnalysis.hs 599
-                self `isSuperSetOf` value (VsNodes mempty (Set.singleton n))
+                addRule $ self `isSuperSetOf` value (VsNodes mempty (Set.singleton n))
hunk ./Grin/PointsToAnalysis.hs 601
-                    modifiedSuperSetOf self a $ \a' -> pruneNodes $ VsNodes (Map.singleton (n,i) a') (Set.singleton n)
+                    addRule $ modifiedSuperSetOf self a $ \a' -> pruneNodes $ VsNodes (Map.singleton (n,i) a') (Set.singleton n)
hunk ./Grin/PointsToAnalysis.hs 609
-            dynamicRule p1' $ \p1 -> flip mapM_ (Set.toList (getHeaps' "update" p1)) $ \h ->
+            addRule $ dynamicRule p1' $ \p1 -> ioToRule $ flip mapM_ (Set.toList (getHeaps' "update" p1)) $ \h ->
hunk ./Grin/PointsToAnalysis.hs 611
-                    Just (e,_) -> e `isSuperSetOf` p2'
+                    Just (e,_) -> addRule $ e `isSuperSetOf` p2'
hunk ./Grin/PointsToAnalysis.hs 616
-            dynamicRule p1' $ \p1 -> do
+            addRule $ dynamicRule p1' $ \p1 -> ioToRule $ do
hunk ./Grin/PointsToAnalysis.hs 623
-                                    arg `isSuperSetOf` value v
+                                    addRule $ arg `isSuperSetOf` value v
hunk ./Grin/PointsToAnalysis.hs 631
-                                Just arg -> arg `isSuperSetOf` p2'
+                                Just arg -> addRule $ arg `isSuperSetOf` p2'
hunk ./Grin/PointsToAnalysis.hs 636
-            dynamicRule p' $ \p -> flip mapM_ (Set.toList (getHeaps p)) $ \h -> do
+            addRule $ dynamicRule p' $ \p -> ioToRule $ flip mapM_ (Set.toList (getHeaps p)) $ \h -> do
hunk ./Grin/PointsToAnalysis.hs 638
-                    Just (e',(x,_)) | True || x /= UnsharedEval -> dynamicRule e' $ \e -> do
-                        flip mapM_ (fsts [ runIdentity $ Map.lookup (tagFlipFunction n) funcMap | n <- (Set.toList $ getNodes e), tagIsSuspFunction n ]) $ \z -> do
+                    Just (e',(x,_)) | True || x /= UnsharedEval -> addRule $ dynamicRule e' $ \e ->
+                        mconcat $ flip map (fsts [ runIdentity $ Map.lookup (tagFlipFunction n) funcMap | n <- (Set.toList $ getNodes e), tagIsSuspFunction n ]) $ \z ->