[make 'readValue' in fixpoint calculate fixpoint if not done already. allow control over fixpoint debugging info, clean up some info printed to the screen. combined reading,supplying routine
John Meacham <john@repetae.net>**20060126013620] hunk ./E/TypeAnalysis.hs 51
-    findFixpoint fixer
+    calcFixpoint "type analysis" fixer
hunk ./Fixer/Fixer.hs 14
+    calcFixpoint,
hunk ./Fixer/Fixer.hs 29
-import IO(hFlush, stdout)
+import IO(hFlush, stdout, Handle, hPutStr)
hunk ./Fixer/Fixer.hs 34
+-- | Fixable class, must satisfy the following rules
+--
+-- isBottom bottom == True
+-- x `lub` x == x
+-- x `lub` y == y `lub` x
+-- x `lub` bottom == x
+-- x `minus` bottom == x
+-- bottom `minus` x == bottom
+-- x `minus` y == z --> y `lub` z == x
+
hunk ./Fixer/Fixer.hs 171
-
+-- | read result, calculating fixpoint if needed
hunk ./Fixer/Fixer.hs 173
-readValue (IV v) = liftIO $ readIORef (current v)
+readValue (IV v) = liftIO $ do
+    findFixpoint Nothing (fixer v)
+    readIORef (current v)
hunk ./Fixer/Fixer.hs 184
-findFixpoint :: MonadIO m => Fixer -> m ()
-findFixpoint Fixer { vars = vars, todo = todo } = liftIO $ do
+calcFixpoint :: MonadIO m => String -> Fixer -> m ()
+calcFixpoint s fixer = findFixpoint (Just (s,stdout)) fixer
+
+-- | find fixpoint, perhaps printing debugging information to specified handle. will not print anything if no calculation needed.
+findFixpoint :: MonadIO m => Maybe (String,Handle) ->  Fixer -> m ()
+findFixpoint msh@(~(Just (mstring,_))) Fixer { vars = vars, todo = todo } = liftIO $ do
hunk ./Fixer/Fixer.hs 191
+    if Set.null to then return () else do
hunk ./Fixer/Fixer.hs 193
-    putStrLn $ "Fixer: " ++ show (length vars)
hunk ./Fixer/Fixer.hs 196
-            putStr "(" >> putStr (show n) >> putStr ")" >> hFlush stdout
+            mputStr "(" >> mputStr (show n) >> mputStr ")" >> mFlush
hunk ./Fixer/Fixer.hs 198
-        f [] _ = putStrLn "" >> return ()
+        f [] _ = mputStr "\n" >> mFlush >> return ()
hunk ./Fixer/Fixer.hs 212
+        mputStr s = case msh of
+            Nothing -> return ()
+            Just (_,h) -> hPutStr h s
+        mFlush = case msh of
+            Nothing -> return ()
+            Just (_,h) -> hFlush h
+    mputStr $ "Finding fixpoint for " ++ mstring ++ ": " ++ "[" ++ show (Set.size to) ++ "]"
+    mFlush
hunk ./Fixer/Fixer.hs 222
+
hunk ./Fixer/Supply.hs 6
+    readSValue,
hunk ./Fixer/Supply.hs 48
+readSValue :: (MonadIO m, Ord b, Fixable a) => Supply b a -> b -> m a
+readSValue s b = do
+    v <- supplyValue s b
+    readValue v
hunk ./Grin/DeadCode.hs 42
-    findFixpoint fixer
+    calcFixpoint "Dead Code" fixer
+    supplyReadValues usedArgs >>= mapM_ print
+    supplyReadValues usedFuncs >>= mapM_ print
+    supplyReadValues usedCafs >>= mapM_ print
hunk ./Grin/Linear.hs 30
-    findFixpoint fixer
+    calcFixpoint "linear nodes" fixer
hunk ./Grin/PointsToAnalysis.hs 683
-    CharIO.putStrLn "About to solve fixpoint.."
-    findFixpoint fr
+    calcFixpoint "points-to" fr