[change Occurance to a UseInfo structure to record various bits of information about how variables are used
John Meacham <john@repetae.net>**20060814070017] hunk ./E/SSimplify.hs 66
+    deriving(Show,Eq,Ord)
+
+data UseInfo = UseInfo {
+    useOccurance :: !Occurance,   -- ^ occurance Info
+    minimumArgs  :: !Int          -- ^ minimum number of args that are ever passed to this function (if used)
+    }
hunk ./E/SSimplify.hs 74
+noUseInfo = UseInfo { useOccurance = Many, minimumArgs = 0 }
+notUsedInfo = UseInfo { useOccurance = Unused, minimumArgs = maxBound }
hunk ./E/SSimplify.hs 80
-        (dsIn',(OMap fvs,uids)) = runReaderWriter (unOM $ collectDs dsIn $ if progClosed prog then mempty else fromList $ map (flip (,) Many) (map (tvrIdent . fst) dsIn)) (fromList $ map tvrIdent $ progEntryPoints prog)
+        (dsIn',(OMap fvs,uids)) = runReaderWriter (unOM $ collectDs dsIn $ if progClosed prog then mempty else fromList $ map (flip (,) noUseInfo) (map (tvrIdent . fst) dsIn)) (fromList $ map tvrIdent $ progEntryPoints prog)
hunk ./E/SSimplify.hs 89
-newtype OMap = OMap (IdMap Occurance)
-   deriving(HasSize,SetLike,BuildSet (Id,Occurance),MapLike Id Occurance,Show,IsEmpty,Eq,Ord)
+newtype OMap = OMap (IdMap UseInfo)
+   deriving(HasSize,SetLike,BuildSet (Id,UseInfo),MapLike Id UseInfo,Show,IsEmpty,Eq,Ord)
hunk ./E/SSimplify.hs 105
-collectOccurance' :: E -> (E,IdMap Occurance)
+collectOccurance' :: E -> (E,IdMap UseInfo)
hunk ./E/SSimplify.hs 146
-        tell $ (msingleton n Once,mempty)
+        tell $ (msingleton n UseInfo { useOccurance = Once, minimumArgs = 0 },mempty)
hunk ./E/SSimplify.hs 149
+    f e | (EVar tvr@TVr { tvrIdent = n, tvrType = t},xs@(_:_)) <- fromAp e = do
+        tell $ (msingleton n UseInfo { useOccurance = Once, minimumArgs = length xs },mempty)
+        t <- arg (f t)
+        xs <- arg (mapM f xs)
+        return (foldl EAp (EVar tvr { tvrType = t}) xs)
hunk ./E/SSimplify.hs 167
-    f (ELetRec ds e) = do
+    f ELetRec { eDefs = ds, eBody = e } = do
hunk ./E/SSimplify.hs 181
-        let mm (OMap mp,y) = (OMap $ fmap (const Many) mp,y)
+        let mm (OMap mp,y) = (OMap $ fmap (const noUseInfo) mp,y)
hunk ./E/SSimplify.hs 188
-annb' tvr = tvrInfo_u (Info.delete Many) tvr
+annb' tvr = tvrInfo_u (Info.delete noUseInfo) tvr
hunk ./E/SSimplify.hs 195
-    Nothing -> annb Unused tvr { tvrIdent = 0 }
+    Nothing -> annb notUsedInfo tvr { tvrIdent = 0 }
hunk ./E/SSimplify.hs 210
-        romap = OMap $ fmap (const Many) rvars
+        romap = OMap $ fmap (const noUseInfo) rvars
hunk ./E/SSimplify.hs 234
-            True -> LoopBreaker
+            True -> noUseInfo { useOccurance = LoopBreaker }
hunk ./E/SSimplify.hs 236
-                True -> Many
+                True -> noUseInfo
hunk ./E/SSimplify.hs 242
-        nfid' = fmap (const Many) (mconcat nfids)
+        nfid' = fmap (const noUseInfo) (mconcat nfids)
hunk ./E/SSimplify.hs 252
-    il Once = OnceInLam
-    il _ = Many
+    il ui@UseInfo { useOccurance = Once } = ui { useOccurance = OnceInLam }
+    il ui = ui { useOccurance = Many }
hunk ./E/SSimplify.hs 255
+--andOM :: IdMap UseInfo -> IdMap UseInfo -> IdMap UseInfo
hunk ./E/SSimplify.hs 257
-andOcc Unused x = x
-andOcc x Unused = x
-andOcc _ _ = Many
+andOcc UseInfo { useOccurance = Unused } x = x
+andOcc x UseInfo { useOccurance = Unused } = x
+andOcc x y = UseInfo { useOccurance = Many, minimumArgs = min (minimumArgs x) (minimumArgs y) }
hunk ./E/SSimplify.hs 265
-orMany [x] = x
-orMany xs = if all (== Once) xs then ManyBranch else Many
+orMany xs = f (filter ((/= Unused) . useOccurance) xs) where
+    f [] = notUsedInfo
+    f [x] = x
+    f xs = if all good (map useOccurance xs) then ui ManyBranch else ui Many where
+        good Once = True
+        good ManyBranch = True
+        good _ = False
+        ui x = UseInfo { minimumArgs =  minimum (map minimumArgs xs), useOccurance = x }
hunk ./E/SSimplify.hs 308
-    bindingOccurance = o,
+    bindingOccurance = useOccurance o,
hunk ./E/SSimplify.hs 311
-    inlineForced = if o == LoopBreaker then ForceNoinline else NotForced,
+    inlineForced = if useOccurance o == LoopBreaker then ForceNoinline else NotForced,
hunk ./E/SSimplify.hs 442
-        in cacheSubst mempty { envSubst = fromList $ concatMap bb  (massocs $ so_boundVars sopts),  envInScope =  fmap (\ (t,e) -> fixInline finalPhase t $ isBoundTo Many e) (so_boundVars sopts) }
+        in cacheSubst mempty { envSubst = fromList $ concatMap bb  (massocs $ so_boundVars sopts),  envInScope =  fmap (\ (t,e) -> fixInline finalPhase t $ isBoundTo noUseInfo e) (so_boundVars sopts) }
hunk ./E/SSimplify.hs 510
-    g (ELetRec ds@(_:_) e) inb = do
+    g ELetRec { eDefs = ds@(_:_), eBody =  e } inb = do
hunk ./E/SSimplify.hs 518
-                let fn ds (ELetRec ds' e) | not (hasRepeatUnder fst (ds ++ ds')) = fn (ds' ++ ds) e
+                let fn ds (ELetRec { eDefs = ds', eBody = e}) | not (hasRepeatUnder fst (ds ++ ds')) = fn (ds' ++ ds) e
hunk ./E/SSimplify.hs 520
-                        f ((t,ELetRec ds' e):rs) us ds b | all (not . (`Set.member` us)) (fsts ds') = f ((t,e):rs) (Set.fromList (fsts ds') `Set.union` us) (ds':ds) True
+                        f ((t,ELetRec { eDefs = ds', eBody = e}):rs) us ds b | all (not . (`Set.member` us)) (fsts ds') = f ((t,e):rs) (Set.fromList (fsts ds') `Set.union` us) (ds':ds) True
hunk ./E/SSimplify.hs 539
-    doCase (ELetRec ds e) t b as d inb = do
+    doCase ELetRec { eDefs = ds, eBody = e} t b as d inb = do
hunk ./E/SSimplify.hs 592
-        d' <- f d (insertDoneSubst b (EVar b') (insertInScope (tvrIdent b') (fixInline finalPhase b' $ isBoundTo Many e) inb))
+        d' <- f d (insertDoneSubst b (EVar b') (insertInScope (tvrIdent b') (fixInline finalPhase b' $ isBoundTo noUseInfo e) inb))
hunk ./E/SSimplify.hs 597
-        d' <- f d (insertDoneSubst b (EVar b') (insertInScope (tvrIdent b') (fixInline finalPhase b' $ isBoundTo Many e) inb))
+        d' <- f d (insertDoneSubst b (EVar b') (insertInScope (tvrIdent b') (fixInline finalPhase b' $ isBoundTo noUseInfo e) inb))
hunk ./E/SSimplify.hs 624
-                return $ (insertInScope (tvrIdent v) (isBoundTo Many (EVar b')),b')
-            (EVar v,_) -> return $ (insertDoneSubst b (EVar b') . insertInScope (tvrIdent v) (isBoundTo Many (EVar b')),b')
+                return $ (insertInScope (tvrIdent v) (isBoundTo noUseInfo (EVar b')),b')
+            (EVar v,_) -> return $ (insertDoneSubst b (EVar b') . insertInScope (tvrIdent v) (isBoundTo noUseInfo (EVar b')),b')
hunk ./E/SSimplify.hs 644
-            mins _ e | 0 `notMember` (freeVars e :: IdSet) = insertInScope (tvrIdent b') (isBoundTo Many e)
+            mins _ e | 0 `notMember` (freeVars e :: IdSet) = insertInScope (tvrIdent b') (isBoundTo noUseInfo e)
hunk ./E/SSimplify.hs 671
-                e' <- f e (substAddList [ (n,Done $ EVar nt) | (_,TVr { tvrIdent = n },nt) <- binds] $ envInScope_u (fromList [ (n,isBoundTo Many e) | (e,_,TVr { tvrIdent = n }) <- binds] `union`) inb)
+                e' <- f e (substAddList [ (n,Done $ EVar nt) | (_,TVr { tvrIdent = n },nt) <- binds] $ envInScope_u (fromList [ (n,isBoundTo noUseInfo e) | (e,_,TVr { tvrIdent = n }) <- binds] `union`) inb)
hunk ./E/SSimplify.hs 772
-        let z :: (InTVr,InE) -> SM m (Id,Occurance,OutTVr,InE)
+        let z :: (InTVr,InE) -> SM m (Id,UseInfo,OutTVr,InE)
hunk ./E/SSimplify.hs 776
-                return (tvrIdent t,Many,t'',EError "<<loop>>" (getType t))
+                return (tvrIdent t,noUseInfo,t'',EError "<<loop>>" (getType t))
hunk ./E/SSimplify.hs 780
-                    _ | forceNoinline t -> return (tvrIdent t,LoopBreaker,t',e)
-                    Just Once -> return (tvrIdent t,Once,error $ "Once: " ++ show t,e)
+                    _ | forceNoinline t -> return (tvrIdent t,noUseInfo { useOccurance = LoopBreaker },t',e)
+                    Just ui@UseInfo { useOccurance = Once } -> return (tvrIdent t,ui,error $ "Once: " ++ show t,e)
hunk ./E/SSimplify.hs 784
-                    Nothing -> return (tvrIdent t,LoopBreaker,t',e)
+                    Nothing -> return (tvrIdent t,noUseInfo { useOccurance = LoopBreaker },t',e)
hunk ./E/SSimplify.hs 786
-            w :: [(Id,Occurance,OutTVr,InE)] -> Env -> [(OutTVr,OutE)] -> SM m ([(OutTVr,OutE)],Env)
-            w ((t,Once,t',e):rs) inb ds = do
+            w :: [(Id,UseInfo,OutTVr,InE)] -> Env -> [(OutTVr,OutE)] -> SM m ([(OutTVr,OutE)],Env)
+            w ((t,UseInfo { useOccurance = Once },t',e):rs) inb ds = do
hunk ./E/SSimplify.hs 815
-        let sub'' = fromList [ (t,susp e sub'') | (t,Once,_,e) <- s'] `union` fromList [ (t,Done (EVar t'))  | (t,n,t',_) <- s', n /= Once] `union` envSubst inb
-        (ds',inb') <- w s'  (cacheSubst (envSubst_s sub'' $ envInScope_u (fromList [ (tvrIdent t',NotKnown) | (_,n,t',_) <- s', n /= Once] `union`) inb)) []
+        let sub'' = fromList [ (t,susp e sub'') | (t, UseInfo { useOccurance = Once },_,e) <- s'] `union` fromList [ (t,Done (EVar t'))  | (t,n,t',_) <- s', useOccurance n /= Once] `union` envSubst inb
+        (ds',inb') <- w s'  (cacheSubst (envSubst_s sub'' $ envInScope_u (fromList [ (tvrIdent t',NotKnown) | (_,n,t',_) <- s', useOccurance n /= Once] `union`) inb)) []