[clean up UnionSolve implementation, catch errors earlier
John Meacham <john@repetae.net>**20120118014644
 Ignore-this: 1ade2f18a77cead4fd08b33a79df6cc8
] hunk ./src/Grin/NodeAnalyze.hs 25
-import Util.UnionSolve2 as Util.UnionSolve
+import Util.UnionSolve
hunk ./src/Util/UnionSolve.hs 7
-    islte,isgte,equals,
hunk ./src/Util/UnionSolve.hs 8
-    varIsInteresting
+    islte,isgte,equals
hunk ./src/Util/UnionSolve.hs 13
-import qualified Data.Sequence as S
hunk ./src/Util/UnionSolve.hs 14
-import qualified Data.Set as Set
hunk ./src/Util/UnionSolve.hs 15
+import qualified Data.Sequence as S
+import qualified Data.Set as Set
hunk ./src/Util/UnionSolve.hs 43
+
hunk ./src/Util/UnionSolve.hs 53
-data CL l v = (Either v l) `Clte` (Either v l) | (Either v l) `Cset` (Either v l) | CLAnnotate String (CL l v)
-    deriving(Eq,Ord)
+
+data Op = OpLte | OpEq | OpGte
+
+instance Show Op where
+    show OpEq  = " = "
+    show OpGte = " >= "
+    show OpLte = " <= "
+
+data CL l v = CV v Op v | CL v Op l | CLAnnotate String (CL l v)
hunk ./src/Util/UnionSolve.hs 73
-    showsPrec _ (x `Clte` y) = seither x . showString " <= " . seither y
-    showsPrec _ (x `Cset` l) = seither x . showString " := " . seither l
-    showsPrec _ (CLAnnotate s w) = showString s . showChar '@' . shows w
+    showsPrec _ x = case x of
+        CV v1 op v2 -> shows v1 . shows op . shows v2
+        CL v1 op v2 -> shows v1 . shows op . shows v2
+
+bool t f b = if b then t else f
hunk ./src/Util/UnionSolve.hs 80
-islte,isgte,equals :: Ord v => Either v l -> Either v l -> C l v
-islte  x y = C (S.singleton (x `Clte` y)) mempty
-isgte  x y = islte y x
-equals x y = C (S.singleton (x `Cset` y)) mempty
+islte,isgte,equals :: (Fixable l,Ord v) => Either v l -> Either v l -> C l v
+islte (Left v1) (Left v2) = C (S.singleton (CV v1 OpLte v2)) mempty
+islte (Left v1) (Right v2) = C (S.singleton (CL v1 OpLte v2)) mempty
+islte (Right v1) (Left v2) = C (S.singleton (CL v2 OpGte v1)) mempty
+islte (Right l1) (Right l2) = bool mempty (error $ "invalid constraint: " ++ showFixable l1 ++ " <= " ++ showFixable l2) (l1 `lte` l2)
+
+isgte (Left v1) (Left v2) = C (S.singleton (CV v2 OpLte v1)) mempty
+isgte (Left v1) (Right v2) = C (S.singleton (CL v1 OpGte v2)) mempty
+isgte (Right v1) (Left v2) = C (S.singleton (CL v2 OpLte v1)) mempty
+isgte (Right l1) (Right l2) = bool mempty (error $ "invalid constraint: " ++ showFixable l1 ++ " >= " ++ showFixable l2) (l2 `lte` l1)
hunk ./src/Util/UnionSolve.hs 91
-varIsInteresting :: v -> C l v
-varIsInteresting v = C mempty (Set.singleton v)
+equals (Left v1) (Left v2) = C (S.singleton (CV v1 OpEq v2)) mempty
+equals (Left v1) (Right v2) = C (S.singleton (CL v1 OpEq v2)) mempty
+equals (Right v1) (Left v2) = C (S.singleton (CL v2 OpEq v1)) mempty
+equals (Right l1) (Right l2) = bool mempty (error $ "invalid constraint: " ++ showFixable l1 ++ " = " ++ showFixable l2) (l1 `eq` l2)
hunk ./src/Util/UnionSolve.hs 121
-collectVars (Cset x y:xs) = x:y:collectVars xs
-collectVars (Clte x y:xs) = x:y:collectVars xs
+collectVars (CV x _ y:xs) = x:y:collectVars xs
+collectVars (CL x _ _:xs) = x:collectVars xs
hunk ./src/Util/UnionSolve.hs 137
-    let vars = Set.fromList [ x | Left x <- collectVars cs]
+    let vars = Set.fromList (collectVars cs)
hunk ./src/Util/UnionSolve.hs 143
-        prule (Left x `Clte` Left y) = ans where
+        prule (CV x OpLte y) = ans where
hunk ./src/Util/UnionSolve.hs 150
-        prule (Right x `Clte` Left y) = ans where
+        prule (CV x OpGte y) = prule (CV y OpLte x)
+        prule (CL y OpGte x) = ans where
hunk ./src/Util/UnionSolve.hs 156
-        prule (Left x `Clte` Right y) = ans where
+        prule (CL x OpLte y) = ans where
hunk ./src/Util/UnionSolve.hs 161
-        prule (Right v `Cset` Left x) = prule (Left x `Cset` Right v)
-        prule (Left x `Cset` Right v) = ans where
+        prule (CL x OpEq v) = ans where
hunk ./src/Util/UnionSolve.hs 166
-        prule (Left x `Cset` Left y) = ans where
+        prule (CV x OpEq y) = ans where
hunk ./src/Util/UnionSolve.hs 177
-        prule (Right x `Cset` Right y)
-            | x `eq` y = return ()
-            | otherwise = fail $ "equality of two different values" ++ show (x,y)
-        prule (Right x `Clte` Right y)
-            | x `lte` y = return ()
-            | otherwise = fail $ "invalid constraint: " ++ show x ++ " <= " ++ show y
+     --   prule (Right x `Cset` Right y)
+    --        | x `eq` y = return ()
+    --        | otherwise = fail $ "equality of two different values" ++ show (x,y)
+    --    prule (Right x `Clte` Right y)
+    --        | x `lte` y = return ()
+    --        | otherwise = fail $ "invalid constraint: " ++ show x ++ " <= " ++ show y
hunk ./src/Util/UnionSolve.hs 323
--- bottom is zero and the join is the maximum of integer values, as in this is the lattice of maximum, not the additive one.
+-- join is the maximum of integer values, as in this is the lattice of maximum, not the additive one.