[clean up more of UnionSolve
John Meacham <john@repetae.net>**20120118055552
 Ignore-this: 1203aea3e69193ae338f5090f7c0708e
] hunk ./src/Util/UnionFind.hs 20
-data Element w a = Element a {-# UNPACK #-} !Int {-# UNPACK #-} !(IORef (Link w a))
+data Element w a = Element a {-# UNPACK #-} !Unique {-# UNPACK #-} !(IORef (Link w a))
hunk ./src/Util/UnionFind.hs 28
-    n <- liftM hashUnique newUnique
+    n <- newUnique
hunk ./src/Util/UnionSolve.hs 86
-islte (Left v1) (Left v2) = C (S.singleton (CV v1 OpLte v2))
-islte (Left v1) (Right v2) = C (S.singleton (CL v1 OpLte v2))
-islte (Right v1) (Left v2) = C (S.singleton (CL v2 OpGte v1))
+islte (Left v1) (Left v2)   = C (S.singleton (CV v1 OpLte v2))
+islte (Left v1) (Right v2)  = C (S.singleton (CL v1 OpLte v2))
+islte (Right v1) (Left v2)  = C (S.singleton (CL v2 OpGte v1))
hunk ./src/Util/UnionSolve.hs 91
-isgte (Left v1) (Left v2) = C (S.singleton (CV v2 OpLte v1))
-isgte (Left v1) (Right v2) = C (S.singleton (CL v1 OpGte v2))
-isgte (Right v1) (Left v2) = C (S.singleton (CL v2 OpLte v1))
+isgte (Left v1) (Left v2)   = C (S.singleton (CV v1 OpGte v2))
+isgte (Left v1) (Right v2)  = C (S.singleton (CL v1 OpGte v2))
+isgte (Right v1) (Left v2)  = C (S.singleton (CL v2 OpLte v1))
hunk ./src/Util/UnionSolve.hs 96
-equals (Left v1) (Left v2) = C (S.singleton (CV v1 OpEq v2))
-equals (Left v1) (Right v2) = C (S.singleton (CL v1 OpEq v2))
-equals (Right v1) (Left v2) = C (S.singleton (CL v2 OpEq v1))
+equals (Left v1) (Left v2)   = C (S.singleton (CV v1 OpEq v2))
+equals (Left v1) (Right v2)  = C (S.singleton (CL v1 OpEq v2))
+equals (Right v1) (Left v2)  = C (S.singleton (CL v2 OpEq v1))
hunk ./src/Util/UnionSolve.hs 104
-
hunk ./src/Util/UnionSolve.hs 105
-data Result l a = ResultJust a l
-    | ResultBounded {
-        resultRep :: a,
-        resultLB :: Maybe l,
-        resultUB :: Maybe l,
-        resultLBV ::[a],
-        resultUBV ::[a]
-    }
-
-instance (Show l, Show a) => Show (Result l a) where
-    showsPrec _ x = (showResult x ++)
-
-showResult (ResultJust a l) = show a ++ " = " ++ show l
-showResult rb@ResultBounded {} = sb (resultLB rb) (resultLBV rb) ++ " <= " ++ show (resultRep rb) ++ " <= " ++ sb (resultUB rb) (resultUBV rb)  where
-    sb Nothing n | null n = "_"
-    sb (Just x) n | null n = show x
-    sb Nothing n = show n
-    sb (Just x) n = show x ++ show n
hunk ./src/Util/UnionSolve.hs 110
-        let h x m = case Map.lookup x m of
-                Just v -> return (v,m)
+        let h x mp = case Map.lookup x mp of
+                Just v -> return (v,mp)
hunk ./src/Util/UnionSolve.hs 114
-                    return (v, Map.insert x v m)
+                    return (v, Map.insert x v mp)
hunk ./src/Util/UnionSolve.hs 123
-            CLAnnotate s (CLAnnotate s' c) -> f m (CLAnnotate (s ++ "\n" ++ s') c:cs) ar rs
hunk ./src/Util/UnionSolve.hs 126
+check op x y = case op of
+    OpEq -> x `eq` y
+    OpLte -> x `lte` y
+    OpGte -> y `lte` x
+
hunk ./src/Util/UnionSolve.hs 136
-solve putLog (C csp) = do
-    (pcs,varMap) <- prepareConstraints (C csp)
+solve putLog csp = do
+    (pcs,varMap) <- prepareConstraints csp
hunk ./src/Util/UnionSolve.hs 139
-        prule (CV xe OpLte ye) = do
-            xe <- UF.find xe
-            ye <- UF.find ye
-            xe `lessThanOrEqual` ye
hunk ./src/Util/UnionSolve.hs 140
-        prule (CL ye OpGte x) = do
-            ye <- UF.find ye
-            x `lessThan` ye
-        prule (CL xe OpLte y) =  do
-            xe <- UF.find xe
-            y `greaterThan` xe
-        prule (CL xe OpEq v) = do
-            xe <- UF.find xe
-            xe `setValue` v
hunk ./src/Util/UnionSolve.hs 141
+            prule (CV xe OpGte ye)
+            prule (CV xe OpLte ye)
+        prule (CV xe OpLte ye) = do
hunk ./src/Util/UnionSolve.hs 147
-            xe <- UF.find xe
-            ye <- UF.find ye
-            ye `lessThanOrEqual` xe
-        setValue xe v = do
-            putLog $ "Setting value of " ++ show (fromElement xe) ++ " to " ++ show v
-            xw <- getW xe
-            case xw of
-                R c | c `eq` v -> return ()
-                    | otherwise -> fail $ "UnionSolve: equality constraints don't match " ++ show (c,v)  ++ " when setting " ++ show (fromElement xe)
-                Ri ml lb mu ub | testBoundLT ml v && testBoundGT mu v -> do
-                    mapM_ (v `greaterThan`) (Set.toList lb)
-                    mapM_ (v `lessThan`)    (Set.toList ub)
-                    updateW (const (R v)) xe
-                _ -> fail $ "UnionSolve: setValue " ++ show (fromElement xe,xw,v)
+        prule (CL v op l) = do
+            ve <- UF.find v
+            doOp "" ve op l
+            --case op of
+            --    OpGte -> l `lessThan` ve
+            --    OpLte -> l `greaterThan` ve
+            --    OpEq -> ve `setValue` l
+        doOp lvl ve op l = do
+            let doOp' ve op l = doOp ('-':lvl) ve op l
+            ve <- UF.find ve
+            putLog $ lvl ++ "Constraining: " ++ show (fromElement ve) ++ show op ++ show l
+            vw <- getW ve
+            case vw of
+                R c | check op c l -> return ()
+                    | otherwise -> fail $ "UnionSolve: constraint doesn't match (" ++ show c ++ show op ++ show l ++ ") when setting " ++ show (fromElement ve)
+                ri -> case (op,ri) of
+                    (OpEq,Ri ml lb mu ub) | testBoundLT ml l && testBoundGT mu l -> do
+                        updateW (const (R l)) ve
+                        mapM_ (\v -> doOp' v OpLte l) (Set.toList lb)
+                        mapM_ (\v -> doOp' v OpGte l) (Set.toList ub)
+                    (OpEq,_) | otherwise -> fail $ "UnionSolve: setValue " ++ show (fromElement ve,vw,l)
+                    (OpLte,Ri _ _ (Just n) _) | n `lte` l -> return ()
+                    (OpLte,Ri (Just n) _ _ _) | n `eq` l -> doOp' ve OpEq l
+                    (OpGte,Ri (Just n) _ _ _) | l `lte` n -> return ()
+                    (OpGte,Ri _ _ (Just n) _) | n `eq` l -> doOp' ve OpEq l
+                    (OpLte,Ri (Just n) _ _ _) | l `lte` n -> fail $ "UnionSolve: lower than lower bound  " ++ show (fromElement ve,vw,l,n)
+                    (OpGte,Ri _ _ (Just n) _) | n `lte` l -> fail $ "UnionSolve: higher than higher bound  " ++ show (fromElement ve,vw,l,n)
+                    (OpLte,Ri ml lb mu ub) | testBoundLT ml l -> do
+                        doUpdate (Ri ml lb (mmeet (Just l) mu) ub) ve
+                        mapM_ (\v -> doOp' v OpGte l) (Set.toList lb)
+                    (OpGte,Ri ml lb mu ub) | testBoundGT mu l -> do
+                        doUpdate (Ri (mjoin (Just l) ml) lb mu ub) ve
+                        mapM_ (\v -> doOp' v OpLte l) (Set.toList ub)
+                    _ -> fail $ "UnionSolve: bad " ++  show (fromElement ve,vw,op,l)
+                        --mapM_ (lessThan v) (Set.toList ub)
+                   --     doUpdate (Ri ml lb (mmeet (Just l) mu) ub) xe
+                  --      mapM_ (\v -> CL v OpGte) (Set.toList lb)
+         --               mapM_ (greaterThan v) (Set.toList lb)
+          --                     | otherwise -> fail $ "UnionSolve: testBoundLT " ++ show (ml,v)
+        setValue xe v = doOp "*" xe OpEq v
+        greaterThan v xe = doOp "*" xe OpLte v
+        lessThan v xe = doOp "*" xe OpGte v
+--        setValue xe v = do
+--            putLog $ "Setting value of " ++ show (fromElement xe) ++ " to " ++ show v
+--            xw <- getW xe
+--            case xw of
+--                R c | c `eq` v -> return ()
+--                    | otherwise -> fail $ "UnionSolve: equality constraints don't match " ++ show (c,v)  ++ " when setting " ++ show (fromElement xe)
+--                Ri ml lb mu ub | testBoundLT ml v && testBoundGT mu v -> do
+--                    mapM_ (v `greaterThan`) (Set.toList lb)
+--                    mapM_ (v `lessThan`)    (Set.toList ub)
+--                    updateW (const (R v)) xe
+--                _ -> fail $ "UnionSolve: setValue " ++ show (fromElement xe,xw,v)
hunk ./src/Util/UnionSolve.hs 204
-        v `greaterThan` xe = do
-            putLog $ "make sure " ++ show (fromElement xe) ++ " is less than " ++ show v
-            xw <- UF.getW xe
-            case xw of
-                R c | c `lte` v -> return ()
-                    | otherwise -> fail $ "UnionSolve: greaterThan " ++ show (v,c)
-                Ri _ _ (Just n) _ | n `lte` v -> return ()
-                Ri ml lb mu ub | testBoundLT ml v -> do
-                    doUpdate (Ri ml lb (mmeet (Just v) mu) ub) xe
-                    mapM_ (greaterThan v) (Set.toList lb)
-                               | otherwise -> fail $ "UnionSolve: testBoundLT " ++ show (ml,v)
-        v `lessThan` xe = do
-            putLog $ "make sure " ++ show (fromElement xe) ++ " is greater than " ++ show v
-            xw <- getW xe
-            case xw of
-                R c | v `lte` c -> do return ()
-                    | otherwise -> fail $ "UnionSolve: lessThan " ++ show (v,c)
-                Ri (Just n) _ _ _ |  v `lte` n -> do return ()
-                Ri ml lb mu ub | testBoundGT mu v -> do
-                    doUpdate (Ri (mjoin (Just v) ml) lb mu ub) xe
-                    mapM_ (lessThan v) (Set.toList ub)
-                               | otherwise -> fail $ "UnionSolve: testBoundGT " ++ show (mu,v)
+--        v `greaterThan` xe = do
+--            putLog $ "make sure " ++ show (fromElement xe) ++ " is less than " ++ show v
+--            xw <- UF.getW xe
+--            case xw of
+--                R c | c `lte` v -> return ()
+--                    | otherwise -> fail $ "UnionSolve: greaterThan " ++ show (v,c)
+--                Ri _ _ (Just n) _ | n `lte` v -> return ()
+--                Ri ml lb mu ub | testBoundLT ml v -> do
+--                    doUpdate (Ri ml lb (mmeet (Just v) mu) ub) xe
+--                    mapM_ (greaterThan v) (Set.toList lb)
+--                               | otherwise -> fail $ "UnionSolve: testBoundLT " ++ show (ml,v)
+--        v `lessThan` xe = do
+--            putLog $ "make sure " ++ show (fromElement xe) ++ " is greater than " ++ show v
+--            xw <- getW xe
+--            case xw of
+--                R c | v `lte` c -> do return ()
+--                    | otherwise -> fail $ "UnionSolve: lessThan " ++ show (v,c)
+--                Ri (Just n) _ _ _ |  v `lte` n -> do return ()
+--                Ri ml lb mu ub | testBoundGT mu v -> do
+--                    doUpdate (Ri (mjoin (Just v) ml) lb mu ub) xe
+--                    mapM_ (lessThan v) (Set.toList ub)
+--                               | otherwise -> fail $ "UnionSolve: testBoundGT " ++ show (mu,v)
hunk ./src/Util/UnionSolve.hs 240
+            putLog $ "+Constraining: " ++ show (fromElement xe) ++ show OpLte ++ show (fromElement ye)
hunk ./src/Util/UnionSolve.hs 310
+-----------------------------------------------------------
+-- The data type the results of the analysis are placed in.
+-----------------------------------------------------------
+data Result l a =
+    ResultJust {
+        resultRep :: a,
+        resultValue :: l
+    } |
+    ResultBounded {
+        resultRep :: a,
+        resultLB :: Maybe l,
+        resultUB :: Maybe l,
+        resultLBV ::[a],
+        resultUBV ::[a]
+    }
+
+instance (Show l, Show a) => Show (Result l a) where
+    showsPrec _ x = (showResult x ++)
+
+showResult (ResultJust a l) = show a ++ " = " ++ show l
+showResult rb@ResultBounded {} = sb (resultLB rb) (resultLBV rb) ++ " <= " ++ show (resultRep rb) ++ " <= " ++ sb (resultUB rb) (resultUBV rb)  where
+    sb Nothing n | null n = "_"
+    sb (Just x) n | null n = show x
+    sb Nothing n = show n
+    sb (Just x) n = show x ++ show n
+
hunk ./src/Util/UnionSolve.hs 368
+    eq (x,y) (x',y') = (eq x x' && eq y y')
hunk ./src/Util/UnionSolve.hs 388
-data Topped a = Top | Only a
+data Topped a = Only a | Top