[include used and free ids in program structure. fill them in in occurance collection and use them in the simplifier.
John Meacham <john@repetae.net>**20060412053039] hunk ./E/Program.hs 30
+    progUsedIds :: IdSet,         -- ^ filled in by occurance info collection
+    progFreeIds :: IdSet,         -- ^ filled in by occurance info collection
hunk ./E/Program.hs 46
+    progUsedIds = mempty,
+    progFreeIds = mempty,
hunk ./E/SSimplify.hs 4
-    simplifyDs,
-    collectOccurance,
+    collectOccurance',
hunk ./E/SSimplify.hs 68
-        (dsIn',fvs) = collectDs dsIn $ if progClosed prog then mempty else fromList $ map (flip (,) Many) (map (tvrIdent . fst) dsIn)
-    in (programSetDs dsIn' prog)
+        (dsIn',(OMap fvs,uids)) = runReaderWriter (unOM $ collectDs dsIn $ if progClosed prog then mempty else fromList $ map (flip (,) Many) (map (tvrIdent . fst) dsIn)) ()
+    in (programSetDs dsIn' prog) { progFreeIds = idMapToIdSet fvs, progUsedIds = uids }
hunk ./E/SSimplify.hs 72
-newtype OM a = OM (ReaderWriter () OMap a)
-    deriving(Monad,Functor,MonadWriter OMap)
+newtype OM a = OM (ReaderWriter () (OMap,IdSet) a)
+    deriving(Monad,Functor,MonadWriter (OMap,IdSet))
hunk ./E/SSimplify.hs 91
-grump m = censor (const mempty) (listen m)
+grump m = fmap ( \ (x, (y,z)) -> (x,y) ) $ censor (\ (_,y) -> (mempty,y)) (listen m)
hunk ./E/SSimplify.hs 93
-collectOccurance :: E -> (E,IdMap Occurance) -- ^ (annotated expression, free variables mapped to their occurance info)
-collectOccurance e = (fe,omap)  where
-    (fe,OMap omap) = runReaderWriter (unOM (f e)) ()
+collectOccurance' :: E -> (E,IdMap Occurance)
+collectOccurance' e = (fe,omap) where
+    (fe,(OMap omap,_)) = runReaderWriter (unOM $ collectOccurance e) ()
+
+collectOccurance :: E -> OM E -- ^ (annotated expression, free variables mapped to their occurance info)
+collectOccurance e = f e  where
hunk ./E/SSimplify.hs 109
-            Nothing -> tell tfvs >>  return (EPi tvr { tvrIdent =  0, tvrType = a } b)
-            Just occ -> tell (mdelete n tfvs) >> return (EPi (annb' tvr { tvrType = a }) b)
+            Nothing -> tell (tfvs,mempty) >>  return (EPi tvr { tvrIdent =  0, tvrType = a } b)
+            Just occ -> tell (mdelete n tfvs,singleton n) >> return (EPi (annb' tvr { tvrType = a }) b)
hunk ./E/SSimplify.hs 130
-        tell $ inLam $ foldr mdelete avs (map tvrIdent as)
+        tell $ (inLam $ foldr mdelete avs (map tvrIdent as),fromList $ map tvrIdent as)
hunk ./E/SSimplify.hs 134
-        tell $ msingleton n Once
+        tell $ (msingleton n Once,mempty)
hunk ./E/SSimplify.hs 148
-        tell $ mdelete (tvrIdent b) fidm
+        tell $ (mdelete (tvrIdent b) fidm,singleton (tvrIdent b))
hunk ./E/SSimplify.hs 151
-        (e',OMap fve) <- grump (f e)
-        let (ds''',fids) = collectDs ds fve
-        tell (OMap fids)
+        (e',fve) <- grump (f e)
+        ds''' <- collectDs ds fve
hunk ./E/SSimplify.hs 161
-        tell fvs'
+        tell (fvs',fromList $ map tvrIdent (litBinds l))
hunk ./E/SSimplify.hs 164
-        let mm (OMap mp) = (OMap $ fmap (const Many) mp)
+        let mm (OMap mp,y) = (OMap $ fmap (const Many) mp,y)
hunk ./E/SSimplify.hs 189
-collectBinding :: Bind -> (Bind,IdMap Occurance)
-collectBinding (t,e) = runIdentity $ do
-    let (e',omap) = collectOccurance e
-        rvars = freeVars (Info.fetch (tvrInfo t) :: ARules) :: IdMap TVr
-        rvars' = fmap (const Many) rvars
-    return ((t,e'),omap `andOM` rvars')
+collectBinding :: Bind -> OM Bind
+collectBinding (t,e) = do
+    e' <- collectOccurance e
+    let rvars = freeVars (Info.fetch (tvrInfo t) :: ARules) :: IdMap TVr
+    tell (OMap $ fmap (const Many) rvars, singleton (tvrIdent t))
+    return (t,e')
+
+unOMap (OMap x) = x
hunk ./E/SSimplify.hs 198
-collectDs :: [Bind] -> (IdMap Occurance) -> ([Bind],IdMap Occurance)
-collectDs ds fve = runIdentity $ do
-    let ds' = map collectBinding ds
+collectDs :: [Bind] -> OMap -> OM [Bind]
+collectDs ds (OMap fve) = do
+    ds' <- mapM (grump . collectBinding) ds
hunk ./E/SSimplify.hs 205
-        fids = foldl andOM mempty (fve:snds ds'')
+        fids = foldl andOM mempty (fve:map unOMap (snds ds''))
hunk ./E/SSimplify.hs 219
-            (t',fvs) = collectOccurance (tvrType t)
+            (t',fvs) = collectOccurance' (tvrType t)
hunk ./E/SSimplify.hs 222
-    return (ds'''',(nfid' `andOM` fids) S.\\ ffids)
+    tell $ ((OMap $ nfid' `andOM` fids) S.\\ ffids,fromList (map (tvrIdent . fst) ds''''))
+    return (ds'''')
hunk ./E/SSimplify.hs 334
-    (stat,[(_,e')]) =  simplifyDs sopts [(tvrSilly,e)]
+    (stat,[(_,e')]) =  simplifyDs program sopts [(tvrSilly,e)]
hunk ./E/SSimplify.hs 338
-    let (stats,dsIn) = simplifyDs sopts (programDs prog)
+    let (stats,dsIn) = simplifyDs prog sopts (programDs prog)
hunk ./E/SSimplify.hs 342
-simplifyDs :: SimplifyOpts -> [(TVr,E)] -> (Stat,[(TVr,E)])
-simplifyDs sopts dsIn = (stat,dsOut) where
-
+simplifyDs :: Program -> SimplifyOpts -> [(TVr,E)] -> (Stat,[(TVr,E)])
+simplifyDs prog sopts dsIn = (stat,dsOut) where
hunk ./E/SSimplify.hs 350
+        addNamesIdSet (progUsedIds prog)
+        addBoundNamesIdSet (progFreeIds prog)
+        addBoundNamesIdMap (so_boundVars sopts)
hunk ./E/SSimplify.hs 363
-        let (e',_) = collectOccurance e
+        let (e',_) = collectOccurance' e
hunk ./E/SSimplify.hs 524
-        doCase e t b (as ++ ls') Nothing inb
+        ec <- dosub inb emptyCase { eCaseScrutinee = e, eCaseType = t, eCaseBind = b, eCaseAlts = as ++ ls' }
+        return ec { eCaseScrutinee = e }
+        --doCase e t b (as ++ ls') Nothing inb
hunk ./Main.hs 327
-            let (e',_) = SS.collectOccurance e
+            let (e',_) = SS.collectOccurance' e
hunk ./Main.hs 373
-                    let (e',_) = SS.collectOccurance e
+                    let (e',_) = SS.collectOccurance' e
hunk ./Name/Id.hs 12
+    addNamesIdSet,
hunk ./Name/Id.hs 99
+addNamesIdSet nset = IdNameT $ do
+    modify (\ (used,bound) -> (nset `union` used, bound) )