[collect id maps in CollectedHo when reading ho files rather than recreating them anew each time
John Meacham <john@repetae.net>**20061130024404] hunk ./FrontEnd/Tc/Module.hs 111
-tiModules' (CollectedHo me) ms = do
+tiModules' cho ms = do
+    let me = choHo cho
hunk ./Ho/Build.hs 112
-findModule cho@(CollectedHo have) (Left m) ifunc _
-    | m `mmember` (hoExports have) = return (cho,mempty)
-findModule cho@(CollectedHo have) need ifunc func  = do
+findModule cho (Left m) ifunc _
+    | m `mmember` (hoExports . choHo $ cho) = return (cho,mempty)
+findModule cho need ifunc func  = do
hunk ./Ho/Build.hs 118
-    (readHo,ms) <- getModule have name files
+    (readHo,ms) <- nextModule (fmap Just . hoModules . choHo $ cho) [] mempty [Right (name,files)]
hunk ./Ho/Build.hs 124
-            (ho'@(CollectedHo ho''),newHo) <- func ho [ hs | (hs,_,_) <- sc ]
+            (cho',newHo) <- func ho [ hs | (hs,_,_) <- sc ]
hunk ./Ho/Build.hs 127
-                mdeps = [ (m,dep) | m <- mods', Left dep <- Map.lookup m (hoModules ho'')]
-                ldeps = Map.fromList [ x | m <- mods', Right x <- Map.lookup m (hoModules have)]
+                mdeps = [ (m,dep) | m <- mods', Left dep <- Map.lookup m (hoModules . choHo $ cho')]
+                ldeps = Map.fromList [ x | m <- mods', Right x <- Map.lookup m (hoModules . choHo $ cho)]
hunk ./Ho/Build.hs 135
-            f (ho' `mappend` CollectedHo mempty { hoModules = hoModules newHo }) (readHo `mappend` newHo)  scs
+            f (cho' `mappend` collectedHo { choHo = mempty { hoModules = hoModules newHo }}) (readHo `mappend` newHo)  scs
hunk ./Ho/Build.hs 141
-{-
-checkForHoModule :: Module -> IO (Maybe (HoHeader,Ho))
-checkForHoModule (Module m) = loop $ map snd $ searchPaths m
-    where loop []     = return $ fail ("checkForHoModule: Module "++m++" not found.")
-          loop (f:fs) = do e <- doesFileExist f
-                           if e then checkForHoFile f else loop fs
--}
hunk ./Ho/Build.hs 290
+-- | Find a module, returning just the read Ho file and the parsed
+-- contents of files that still need to be processed, This chases dependencies so
+-- you could end up getting parsed source for several files back.
+-- We only look for ho files where there is a cooresponding haskell source file.
hunk ./Ho/Build.hs 302
-
-
hunk ./Ho/Build.hs 345
--- | Find a module, returning just the read Ho file and the parsed
--- contents of files that still need to be processed, This chases dependencies so
--- you could end up getting parsed source for several files back.
--- We only look for ho files where there is a cooresponding haskell source file.
hunk ./Ho/Build.hs 346
-getModule ::
-    Ho          -- ^ initialHo
-    -> String   -- ^ Module name for printing error messages
-    -> [(String,String)]  -- ^ files to search, and the cooresponding ho file
-    -> IO (Ho,[(HsModule,FileDep,String)])
-
-getModule initialHo name files = nextModule (fmap Just $ hoModules initialHo) [] mempty [Right (name,files)]
hunk ./Ho/Build.hs 375
-
-
hunk ./Ho/Build.hs 380
-getFixups :: Ho -> IdMap E
-getFixups ho = fromList [ (tvrIdent x,EVar x) | (x,_) <- melems (hoEs ho)]
-
-applyFixups :: IdMap E -> Ho -> Ho
-applyFixups mie ho = ho { hoEs = fmap f (hoEs ho) , hoRules =  runIdentity (E.Rules.mapBodies (return . sm) (hoRules ho)) } where
-    f (t,e) = (t,sm e)
-    sm = substMap'' (fmap Just mie)
hunk ./Ho/Type.hs 33
-newtype CollectedHo = CollectedHo { choHo :: Ho }
-    deriving(Monoid)
+data CollectedHo = CollectedHo {
+    choExternalNames :: IdSet,
+    choVarMap :: IdMap (Maybe E),
+    choHo :: Ho
+    }
+
+instance Monoid CollectedHo where
+    mempty = collectedHo
+    a `mappend` b = CollectedHo {
+        choExternalNames = choExternalNames a `mappend` choExternalNames b,
+        choVarMap = choVarMap a `mappend` choVarMap b,
+        choHo = choHo a `mappend` choHo b
+        }
+
+choDataTable cho = hoDataTable $ choHo cho
+
+collectedHo :: CollectedHo
+collectedHo = CollectedHo { choExternalNames = mempty, choHo = mempty, choVarMap = mempty }
hunk ./Main.hs 157
-barendregt e = fst $ renameE mempty mempty e -- runIdentity  (renameTraverse' e)
-
hunk ./Main.hs 168
-          {-
-denewtypeProgram prog = transformProgram transDenewtype prog
-transDenewtype = transformParms {
-        transformCategory = "DeNewtype",
-        transformIterate = DontIterate,
-        transformDumpProgress = corePass,
-        transformOperation =  return . denewtype
-        } where
-        -}
+
hunk ./Main.hs 173
---    Identity prog' = annotateProgram mempty (\_ nfo -> return nfo)  (\_ nfo -> return nfo) (\_ nfo -> return nfo) (programSetDs ds prog)
hunk ./Main.hs 193
-processInitialHo (CollectedHo accumho) ho = do
-    let (ds,uids) = runWriter $ annotateDs imap (collectIdAnn rules' (hoProps ho) ) letann lamann (Map.elems $ hoEs ho)
+processInitialHo accumho ho = do
+    let ho' = reprocessHo (hoRules ho) (hoProps ho) ho
+
+        (ds,uids) = runWriter $ annotateDs (choVarMap accumho') (\_ -> return) letann lamann (Map.elems $ hoEs ho')
+        prog = etaAnnotateProgram (programSetDs ds program { progDataTable = choDataTable accumho `mappend` hoDataTable ho })
+
hunk ./Main.hs 200
-        prog = etaAnnotateProgram (denewtype $ programSetDs ds program { progDataTable = hoDataTable accumho `mappend` hoDataTable ho })
-        imap = fromList [ (tvrIdent v,Just (EVar v))| (v,_) <- Map.elems (hoEs accumho)]
-        imapRules = fromList [ (tvrIdent v,Just (EVar v))| (v,_) <- Map.elems (hoEs accumho' `mappend` hoEs ho)]
-        accumho' = reprocessHo rules' (hoProps ho) accumho
+        accumho' = reprocessCho rules' (hoProps ho) accumho
+
+        imapRules = choVarMap accumho'  `mappend` newVarMap -- fromList [ (tvrIdent v,Just (EVar v))| (v,_) <- Map.elems (hoEs accumho' `mappend` hoEs ho)]
+        newVarMap = fromList [ (tvrIdent t,Just (EVar t)) | (t,_) <- programDs prog ]
hunk ./Main.hs 206
-    return $ CollectedHo $ accumho' `mappend` ho { hoUsedIds = uids, hoEs = programEsMap prog }
+    return $ accumho' `mappend` mempty { choVarMap = newVarMap, choExternalNames = idMapToIdSet newVarMap, choHo = ho { hoUsedIds = uids, hoEs = programEsMap prog } }
hunk ./Main.hs 208
+-- reprocess an old ho to include new rules and properties
hunk ./Main.hs 214
+reprocessCho :: Rules -> IdMap Properties -> CollectedHo -> CollectedHo
+reprocessCho rules ps cho = cho { choVarMap = fmap h (choVarMap cho) , choHo = (choHo cho) { hoEs = Map.map f (hoEs $ choHo cho) }} where
+    f (t,e) = (tvrInfo_u (g (tvrIdent t)) t,e)
+    g id = runIdentity . idann rules ps id
+    h (Just (EVar t)) = Just (EVar (tvrInfo_u (g (tvrIdent t)) t))
+
hunk ./Main.hs 236
-processDecls (CollectedHo ho) ho' tiData = do
+processDecls cho ho' tiData = do
hunk ./Main.hs 239
+        ho = choHo cho
hunk ./Main.hs 256
-            progExternalNames = fromList [ tvrIdent n | (n,_) <- Map.elems $ hoEs ho ],
+            progExternalNames = choExternalNames cho,
hunk ./Main.hs 267
-    rules' <- createInstanceRules fullDataTable (hoClassHierarchy ho')   (Map.fromList [ (runIdentity $ fromId (tvrIdent y),(y,z)) | (y,z) <- ds] `mappend` hoEs ho)
+    rules' <- createInstanceRules fullDataTable (hoClassHierarchy ho')  (Map.fromList [ (runIdentity $ fromId (tvrIdent y),(y,z)) | (y,z) <- ds] `mappend` hoEs ho)
hunk ./Main.hs 292
-    ho <- return $ reprocessHo rules allProps ho
+    cho <- return $ reprocessCho rules allProps cho
hunk ./Main.hs 294
-    let brum = fromList [ (tvrIdent n,Just (EVar n)) | (n,_) <- Map.elems $ hoEs ho ] where
hunk ./Main.hs 295
-    prog <- return $ runIdentity $ annotateProgram brum (idann allRules allProps) letann lamann prog
+    prog <- return $ runIdentity $ annotateProgram (choVarMap cho) (idann allRules allProps) letann lamann prog
hunk ./Main.hs 300
-    --let entryPoints = execWriter $ programMapDs_ (\ (t,_) -> when (getProperty prop_EXPORTED t || member (tvrIdent t) rfreevars) (tell [t])) prog
-    --    rfreevars = ruleAllFreeVars rules
+
hunk ./Main.hs 308
-    let initMap = fromList [ (tvrIdent t, Just (EVar t)) | (t,_) <- (Map.elems (hoEs ho))]
hunk ./Main.hs 368
-    prog <- programMapProgGroups initMap  fint prog
+    prog <- programMapProgGroups mempty  fint prog
hunk ./Main.hs 411
-        --smap <- return $ fromList [ (tvrIdent v,(v,lc)) | (v,lc) <- programDs mprog] `union` smap
-        --sopt <- return $ sopt { SS.so_boundVars = smap }
-
hunk ./Main.hs 445
-    return (CollectedHo (newHo `mappend` ho),newHo)
+        newMap = fromList [ (tvrIdent n,Just (EVar n)) | (n,_) <- Map.elems $ hoEs newHo ]
+    return (mempty { choHo = newHo, choExternalNames = idMapToIdSet newMap, choVarMap = newMap  } `mappend` cho,newHo)
hunk ./Main.hs 480
-compileModEnv' (CollectedHo ho,_) = do
+compileModEnv' (cho,_) = do
+    let ho = choHo cho