[make CM monad for collecting points to information
John Meacham <john@repetae.net>**20060815035006] hunk ./Grin/PointsToAnalysis.hs 6
+import Control.Monad.RWS
hunk ./Grin/PointsToAnalysis.hs 432
+newtype CM a = CM (RWS (Map.Map Var W) PointsToEq (Int,HcHash) a)
+    deriving(Monad,MonadWriter PointsToEq,Functor,MonadReader (Map.Map Var W))
+
+instance MonadState HcHash CM where
+    get = CM $ gets snd
+    put n = CM $ modify (\ (x,y) -> (x,n))
+
+
+instance UniqueProducer CM where
+    newUniq = CM $ do
+        modify (\ (x,y) -> (x + 1,y))
+        gets fst
+
+
+
hunk ./Grin/PointsToAnalysis.hs 448
-collect lmap hc st fname (Tup vs :-> exp')
-    | sameLength avs vs = (eq { funcEq = (fname,v):funcEq eq, varEq = varEq eq ++ avs },hc')   where
-    avs = [ (v,Arg fname n) |  Var v _ <- vs | n <- [0..] ]
+collect lmap hc st fname lam = (eq,hc')  where
+    CM cm = collectM fname lam
+    ((_,hc'),eq) = execRWS cm lmap (st,hc)
+
+collectM :: Atom -> Lam -> CM ()
+collectM  fname (~(Tup vs) :-> exp') = ans where
+    ans = do
+        v <- f exp'
+        tell mempty { funcEq = [(fname,v)], varEq = avs }
+    avs = [ (v,Arg fname n) |  ~(Var v _) <- vs | n <- [0..] ]
+
+ --   ans = (eq { funcEq = (fname,v):funcEq eq, varEq = varEq eq ++ avs },hc')   where
hunk ./Grin/PointsToAnalysis.hs 461
-    ((v,hc'),eq) = execUniq st $ (runWriterT (runStateT (f exp') hc))
+ --   ((v,hc'),eq) = execUniq st $ (runWriterT (runStateT (f exp') hc))
hunk ./Grin/PointsToAnalysis.hs 469
+        lmap <- ask
hunk ./Grin/PointsToAnalysis.hs 545
-    g x = error $ unwords ["g",show x]
-collect _ _ _ _ _ = error "collect: bad argument"
+    g x = error $ unwords ["Grin.PointsToAnalysis.collect.g",show x]