[make demand analysis see through literal binds, have it handle default case bindings
John Meacham <john@repetae.net>**20060719035058] hunk ./E/Demand.hs 217
-newtype IM a = IM (Reader (IdMap DemandSignature,DataTable) a)
-    deriving(Monad,Functor,MonadReader (IdMap DemandSignature,DataTable))
+newtype IM a = IM (Reader (Env,DataTable) a)
+    deriving(Monad,Functor,MonadReader (Env,DataTable))
hunk ./E/Demand.hs 220
-getEnv :: IM (IdMap DemandSignature)
+type Env = IdMap (Either DemandSignature E)
+
+getEnv :: IM Env
hunk ./E/Demand.hs 225
-extEnv t e = local (\ (env,dt) -> (minsert (tvrIdent t) e env,dt))
-extEnvs ts = local  (\ (env,dt) -> (mappend (fromList [ (tvrIdent t,s) |  (t,s) <- ts]) env,dt))
+extEnv t e = local (\ (env,dt) -> (minsert (tvrIdent t) (Left e) env,dt))
+extEnvE t e = local (\ (env,dt) -> (minsert (tvrIdent t) (Right e) env,dt))
+extEnvs ts = local  (\ (env,dt) -> (mappend (fromList [ (tvrIdent t,Left s) |  (t,s) <- ts]) env,dt))
hunk ./E/Demand.hs 237
-determineDemandType :: TVr -> Demand -> IM (Bool,DemandType)
+determineDemandType :: TVr -> Demand -> IM (Either DemandType E)
hunk ./E/Demand.hs 245
-        Just ds -> return (True, g ds)
+        Just (Left ds) -> return (Left $ g ds)
+        Just (Right e) -> return (Right e)
hunk ./E/Demand.hs 248
-            Nothing -> return (True,absType)
-            Just ds -> return (True,g ds)
+            Nothing -> return (Left absType)
+            Just ds -> return (Left $ g ds)
hunk ./E/Demand.hs 258
-    (fl,phi :=> sigma) <- determineDemandType v s
-    return (EVar v,(if fl then phi `glb` (demandEnvSingleton v s) else phi) :=> sigma)
+    ddt <- determineDemandType v s
+    (phi :=> sigma) <- case ddt of
+        Left dt -> return dt
+        Right e -> liftM snd $ analyze e s
+    return (EVar v,(phi `glb` (demandEnvSingleton v s)) :=> sigma)
hunk ./E/Demand.hs 309
-analyze ec@ECase { eCaseAlts = [Alt lc@(LitCons h ts _) alt], eCaseDefault = Nothing } s = do
+analyze ec@ECase { eCaseBind = b, eCaseAlts = [Alt lc@(LitCons h ts _) alt], eCaseDefault = Nothing } s = do
hunk ./E/Demand.hs 312
-        Just [_] -> do  -- product type
+        Just [_] -> extEnvE b (eCaseScrutinee ec) $  do  -- product type
hunk ./E/Demand.hs 366
+{-# NOINLINE solveDs #-}
hunk ./E/Demand.hs 376
+solveDs' (Just False) [(t,e@ELit {})] fixup wdone = do
+    (ne,ds) <- topAnalyze t e
+    extEnvE t e $ wdone [(tvrInfo_u (Info.insert (fixup ds)) t,ne)]