[utilize separate prepareConstraints pass in UnionSolve solver
John Meacham <john@repetae.net>**20120118030503
 Ignore-this: 8f8e6df2938cd0f7e5afb6ddf035bcfa
] hunk ./src/Util/UnionSolve.hs 28
-
+    -- lattice operators
hunk ./src/Util/UnionSolve.hs 31
-
hunk ./src/Util/UnionSolve.hs 33
-
+    -- used for debugging
hunk ./src/Util/UnionSolve.hs 35
-
+    -- default methods
hunk ./src/Util/UnionSolve.hs 44
+-- mappended together when used in a writer monad.
+-- (C l v) represents a constraint (or set of constraints) that confine the
+-- variables 'v' to within specific values of 'l'
+
hunk ./src/Util/UnionSolve.hs 66
-seither (Left x) = shows x
-seither (Right x) = shows x
-
hunk ./src/Util/UnionSolve.hs 125
-collectVars (CV x _ y:xs) = x:y:collectVars xs
-collectVars (CL x _ _:xs) = x:collectVars xs
-collectVars (CLAnnotate s x:xs) = collectVars (x:xs)
-collectVars [] = []
-
---
--- (C l v) represents a constraint (or set of constraints) that confine the
--- variables 'v' to within specific values of 'l'
---
+-- replace variables with UnionFind elements
+prepareConstraints :: Ord v => C l v -> IO ([CL l (RS l v)], Map.Map v (RS l v))
+prepareConstraints (C cseq) = f Map.empty (S.toList cseq) id [] where
+    f m (c:cs) ar rs = do
+        let h x m = case Map.lookup x m of
+                Just v -> return (v,m)
+                Nothing -> do
+                    v <- UF.new (Ri Nothing mempty Nothing mempty) x
+                    return (v, Map.insert x v m)
+        case c of
+            CL x op l -> do
+                (x',m') <- h x m
+                f m' cs id (ar (CL x' op l):rs)
+            CV x op y -> do
+                (x',m') <- h x m
+                (y',m'') <- h y m'
+                f m'' cs id (ar (CV x' op y'):rs)
+            CLAnnotate s (CLAnnotate s' c) -> f m (CLAnnotate (s ++ "\n" ++ s') c:cs) ar rs
+            CLAnnotate s c -> f m (c:cs) (ar . CLAnnotate s) rs
+    f m [] _ rs = return (rs,m)
hunk ./src/Util/UnionSolve.hs 152
-    let vars = Set.fromList (collectVars cs)
-        cs = S.toList csp
-    ufs <- flip mapM (Set.toList vars) $ \a -> do
-        uf <- UF.new (Ri Nothing mempty Nothing mempty) a
-        return (a,uf)
+    (pcs,varMap) <- prepareConstraints (C csp)
hunk ./src/Util/UnionSolve.hs 154
-        prule (CV x OpLte y) = ans where
-            Just xe = Map.lookup x umap
-            Just ye = Map.lookup y umap
-            ans = do
-                xe <- UF.find xe
-                ye <- UF.find ye
-                xe `lessThenOrEqual` ye
+        prule (CV xe OpLte ye) = do
+            xe <- UF.find xe
+            ye <- UF.find ye
+            xe `lessThanOrEqual` ye
hunk ./src/Util/UnionSolve.hs 159
-        prule (CL y OpGte x) = ans where
-            Just ye = Map.lookup y umap
-            ans = do
-                ye <- UF.find ye
-                x `lessThen` ye
-        prule (CL x OpLte y) = ans where
-            Just xe = Map.lookup x umap
-            ans = do
-                xe <- UF.find xe
-                y `greaterThen` xe
-        prule (CL x OpEq v) = ans where
-            Just xe = Map.lookup x umap
-            ans = do
-                xe <- UF.find xe
-                xe `setValue` v
-        prule (CV x OpEq y) = ans where
-            Just xe = Map.lookup x umap
-            Just ye = Map.lookup y umap
-            ans = do
-                xe <- UF.find xe
-                ye <- UF.find ye
-                xe `lessThenOrEqual` ye
-                xe <- UF.find xe
-                ye <- UF.find ye
-                ye `lessThenOrEqual` xe
-        -- handle constant cases, just check if valid, and perhaps report error
-     --   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 (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
+        prule (CV xe OpEq ye) = do
+            xe <- UF.find xe
+            ye <- UF.find ye
+            xe `lessThanOrEqual` ye
+            xe <- UF.find xe
+            ye <- UF.find ye
+            ye `lessThanOrEqual` xe
hunk ./src/Util/UnionSolve.hs 182
-                    mapM_ (v `greaterThen`) (Set.toList lb)
-                    mapM_ (v `lessThen`)    (Set.toList ub)
+                    mapM_ (v `greaterThan`) (Set.toList lb)
+                    mapM_ (v `lessThan`)    (Set.toList ub)
hunk ./src/Util/UnionSolve.hs 185
-                _ -> error "Util.UnionSolve: invalid Ri"
+                _ -> fail $ "UnionSolve: setValue " ++ show (fromElement xe,xw,v)
hunk ./src/Util/UnionSolve.hs 190
-        v `greaterThen` xe = do
+        v `greaterThan` xe = do
hunk ./src/Util/UnionSolve.hs 195
-                    | otherwise -> fail $ "UnionSolve: greaterThen " ++ show (v,c)
+                    | otherwise -> fail $ "UnionSolve: greaterThan " ++ show (v,c)
hunk ./src/Util/UnionSolve.hs 199
-                    mapM_ (greaterThen v) (Set.toList lb)
+                    mapM_ (greaterThan v) (Set.toList lb)
hunk ./src/Util/UnionSolve.hs 201
-        v `lessThen` xe = do
+        v `lessThan` xe = do
hunk ./src/Util/UnionSolve.hs 206
-                    | otherwise -> fail $ "UnionSolve: lessThen " ++ show (v,c)
+                    | otherwise -> fail $ "UnionSolve: lessThan " ++ show (v,c)
hunk ./src/Util/UnionSolve.hs 210
-                    mapM_ (lessThen v) (Set.toList ub)
+                    mapM_ (lessThan v) (Set.toList ub)
hunk ./src/Util/UnionSolve.hs 224
-        xe `lessThenOrEqual` ye | xe == ye = return ()
-        xe `lessThenOrEqual` ye = do
+        xe `lessThanOrEqual` ye | xe == ye = return ()
+        xe `lessThanOrEqual` ye = do
hunk ./src/Util/UnionSolve.hs 228
-                R v -> (v `lessThen` ye)
+                R v -> (v `lessThan` ye)
hunk ./src/Util/UnionSolve.hs 236
-                        R v -> (v `greaterThen` xe)
+                        R v -> (v `greaterThan` xe)
hunk ./src/Util/UnionSolve.hs 245
-                                Just v -> mapM_ (v `greaterThen`) (Set.toList xlb)
+                                Just v -> mapM_ (v `greaterThan`) (Set.toList xlb)
hunk ./src/Util/UnionSolve.hs 250
-                                Just v -> mapM_ (v `lessThen`) (Set.toList yub)
+                                Just v -> mapM_ (v `lessThan`) (Set.toList yub)
hunk ./src/Util/UnionSolve.hs 280
-        umap = Map.fromList ufs
-    mapM_ prule cs
-    rs <- flip mapM ufs $ \ (a,e) -> do
+    mapM_ prule pcs
+    rs <- flip mapM (Map.toList varMap) $ \ (a,e) -> do
hunk ./src/Util/UnionSolve.hs 295
--------------------
--- useful instances
--------------------
+-------------------------------
+-- useful instances for Fixable
+-------------------------------