[add ability to propagate the set of bounds when solving boolean constraints
John Meacham <john@repetae.net>**20060510235153] hunk ./Util/BooleanSolver.hs 11
+    Result(..),
hunk ./Util/BooleanSolver.hs 23
+import Data.Typeable
hunk ./Util/BooleanSolver.hs 36
+
+instance Functor C where
+    fmap f (C v) = C (map (fmap f) (v []) ++)
+
hunk ./Util/BooleanSolver.hs 41
-    deriving(Eq,Ord)
+    deriving(Eq,Ord,Typeable)
hunk ./Util/BooleanSolver.hs 141
-processConstraints :: (Show v,MonadIO m) => C (CA v) -> m ()
-processConstraints (C cs) = mapM_ prule (cs []) where
+processConstraints :: (Show v,MonadIO m)
+    => Bool      -- ^ whether to propagate subset/superset info. if you only care about fixed results you don't need to do this. if you care about residual constraints and equivalance classes after solving then you should set this.
+    -> C (CA v)  -- ^ the input
+    -> m ()
+processConstraints propagateSets (C cs) = mapM_ prule (cs []) where
hunk ./Util/BooleanSolver.hs 153
+    pimp' :: (MonadIO m,Show a) => RS a -> RS a -> m ()
+    pimp' x y = do x <- find x; y <- find y; pimp x y
hunk ./Util/BooleanSolver.hs 177
-    implies :: RS a -> RS a -> Ri a -> Ri a -> IO ()
+    implies :: (MonadIO m,Show a) => RS a -> RS a -> Ri a -> Ri a -> m ()
hunk ./Util/BooleanSolver.hs 181
-        if xe `Set.member` yh then equals xe ye ra rb else do
+        if xe `Set.member` yh then liftIO $ equals xe ye ra rb else do
hunk ./Util/BooleanSolver.hs 183
-        if ye `Set.member` xl then equals xe ye ra rb else do
+        if ye `Set.member` xl then liftIO $ equals xe ye ra rb else do
hunk ./Util/BooleanSolver.hs 187
+        when propagateSets $ mapM_ (pimp' xe) (Set.toList yh)
+        when propagateSets $ mapM_ (flip pimp' ye) (Set.toList xl)
hunk ./Util/BooleanSolver.hs 194
-    equals :: RS a -> RS a -> Ri a -> Ri a -> IO ()
hunk ./Util/BooleanSolver.hs 198
+        when propagateSets $ do
+            Ri nl nh <- findRi xe (Ri nl nh)
+            putW xe (CJust $ Ri nl nh)
+            let eq = Set.intersection nl nh
+            flip mapM_ (Set.toList eq) $ \ne -> do
+                ne <- find ne
+                CJust ri <- getW ne
+                ri <- findRi ne ri
+                equals xe ne (Ri nl nh) ri
+            return ()
+        return () :: IO ()