[clean up code, handle typecases of compound type constructors properlyish
John Meacham <john@repetae.net>**20070516040419] hunk ./E/TypeAnalysis.hs 74
-    flip mapM_ entries $ \tvr ->  do
+    forM_ entries $ \tvr ->  do
hunk ./E/TypeAnalysis.hs 117
-                        flip mapM_ (zip naturals (zip as as')) $ \ (i,(a',a'')) -> do
+                        forMn_ ((zip as as')) $ \ ((a',a''),i) -> do
hunk ./E/TypeAnalysis.hs 136
-    flip mapM_ ds $ \ (v,e) -> do calcDef env (v,e)
+    forM_ ds $ \ (v,e) -> do calcDef env (v,e)
hunk ./E/TypeAnalysis.hs 148
-        flip mapM_ (zip xs' [0.. ])  $ \ (v,i) -> do
+        forMn_ xs' $ \ (v,i) -> do
hunk ./E/TypeAnalysis.hs 163
-        flip mapM_ (zip [0..] xs) $ \ (i,t) -> do
+        forMn_ xs $ \ (t,i) -> do
hunk ./E/TypeAnalysis.hs 172
---calcE env ec@ECase {} | sortKindLike (getType $ eCaseScrutinee ec) = do
---    calcE env (eCaseScrutinee ec)
---    fmapM_ (calcE env) (eCaseDefault ec)
---    v <- getValue (eCaseScrutinee ec)
---    mapM_ (calcAlt env v) (eCaseAlts ec)
+calcE env ec@ECase {} | sortKindLike (getType $ eCaseScrutinee ec) = do
+    calcE env (eCaseScrutinee ec)
+    fmapM_ (calcE env) (eCaseDefault ec)
+    v <- getValue (eCaseScrutinee ec)
+    mapM_ (calcAlt env v) (eCaseAlts ec)
hunk ./E/TypeAnalysis.hs 189
-    flip mapM_ (zip as ts) $ \ (a,t) -> do
+    forM_ (zip as ts) $ \ (a,t) -> do
hunk ./E/TypeAnalysis.hs 253
+data SpecEnv = SpecEnv {
+    senvUnusedRules :: Set.Set (Module,Int),
+    senvUnusedVars  :: Set.Set TVr,
+    senvDataTable :: DataTable,
+    senvArgs      :: Map.Map TVr [Int]
+    }
hunk ./E/TypeAnalysis.hs 260
-type SpecEnv = (Set.Set (Module,Int),Set.Set TVr,DataTable,Map.Map TVr [Int])
hunk ./E/TypeAnalysis.hs 277
-    -> (Set.Set (Module,Int))  -- ^ used rules
-    -> (Set.Set TVr)           -- ^ used values
+    -> (Set.Set (Module,Int))  -- ^ unused rules
+    -> (Set.Set TVr)           -- ^ unused values
hunk ./E/TypeAnalysis.hs 281
-specializeProgram doSpecialize usedRules usedValues prog = do
-    (nds,_) <- specializeDs doSpecialize (usedRules,usedValues,progDataTable prog,mempty) (programDs prog)
+specializeProgram doSpecialize unusedRules unusedValues prog = do
+    (nds,_) <- specializeDs doSpecialize SpecEnv { senvUnusedRules = unusedRules, senvUnusedVars = unusedValues, senvDataTable = progDataTable prog, senvArgs = mempty } (programDs prog)
hunk ./E/TypeAnalysis.hs 289
-specializeDef _ (_,unusedVals,_,_) (tvr,e) | tvr `Set.member` unusedVals = return (tvr,EError "Unused" (tvrType tvr))
+specializeDef _ SpecEnv { senvUnusedVars = unusedVals }  (tvr,e) | tvr `Set.member` unusedVals = return (tvr,EError "Unused" (tvrType tvr))
hunk ./E/TypeAnalysis.hs 291
-specializeDef True (_,_,dataTable,_) (tvr,e) = ans where
+specializeDef True SpecEnv { senvDataTable = dataTable }  (tvr,e) = ans where
hunk ./E/TypeAnalysis.hs 308
-specBody _ env@(_,unusedVars,dataTable,_) e | (EVar h,as) <- fromAp e, h `Set.member` unusedVars = do
+specBody _ env@SpecEnv { senvUnusedVars = unusedVars, senvDataTable = dataTable } e | (EVar h,as) <- fromAp e, h `Set.member` unusedVars = do
hunk ./E/TypeAnalysis.hs 311
-specBody True (_,_,_,dmap) e | (EVar h,as) <- fromAp e, Just os <- mlookup h dmap = do
+specBody True SpecEnv { senvArgs = dmap } e | (EVar h,as) <- fromAp e, Just os <- mlookup h dmap = do
hunk ./E/TypeAnalysis.hs 314
+--specBody True env e@ECase { eCaseScrutinee = EVar v } | sortKindLike (getType v)scrut = do
+--    k
hunk ./E/TypeAnalysis.hs 323
-specializeDs doSpecialize env@(unusedRules,_,dataTable,_) ds = do
+specializeDs doSpecialize env@SpecEnv { senvUnusedRules = unusedRules, senvDataTable = dataTable }  ds = do
hunk ./E/TypeAnalysis.hs 331
-        tenv = ((\ (a,b,c,d) -> (a,b,c,nenv `mappend` d)) env)
+        tenv = env { senvArgs = nenv `mappend` senvArgs env }