[get rid of redundant searching for module exports in renamer
John Meacham <john@repetae.net>**20100715201919
 Ignore-this: dbd7c14d07437a0a7ad71ea97e510198
] hunk ./src/FrontEnd/Rename.hs 60
+addTopLevels :: HsModule -> RM a -> RM a
+addTopLevels  hsmod action = do
+    mod <- getCurrentModule
+    let cdefs = map (\ (x,y,_) -> (x,y)) $ fst $ collectDefsHsModule hsmod
+    --let (ns,ts) = mconcat (map namesHsDecl hsDecls)
+    --    nm = Map.fromList $ foldl f [] (fsts ns)
+    --    tm = Map.fromList $ foldl f [] (fsts ts)
+        nmap = foldl f [] (fsts cdefs)
+        f r hsName@(getModule -> Just _)
+            | Just _ <- V.fromTupname hsName, Module "Jhc.Basics" <- mod
+                = let nn = hsName in (nn,nn):r
+            | nameName tc_Arrow == hsName, Module "Jhc.Basics" == mod
+                = let nn = hsName in (nn,nn):r
+ --           | otherwise = error $ "strong bad: " ++ show hsName
+            | otherwise = let nn = toUnqualified hsName in (nn,hsName):(hsName,hsName):r
+        --f r z@(UnQual n) = let nn = Qual mod n in (z,nn):(nn,nn):r
+        f r z@(getModule -> Nothing) = let nn = qualifyName mod z in (z,nn):(nn,nn):r
+        z ns = mapM mult (filter (\x -> length x > 1) $ groupBy (\a b -> fst a == fst b) (sort ns))
+        mult xs@(~((n,sl):_)) = warn sl "multiply-defined" (show n ++ " is defined multiple times: " ++ show xs )
+    --z cdefs
+    withSubTable (Map.fromList nmap) action
+
+
+{-
hunk ./src/FrontEnd/Rename.hs 102
-
+-}
hunk ./src/FrontEnd/Rename.hs 142
-renameDecls tidy = do
-    withSrcLoc (hsModuleSrcLoc tidy) $ do
-    addTopLevels (hsModuleDecls tidy) $ do
-    decls' <- rename (hsModuleDecls tidy)
+renameDecls mod = do
+    withSrcLoc (hsModuleSrcLoc mod) $ do
+    addTopLevels mod $ do
+    decls' <- rename (hsModuleDecls mod)
hunk ./src/FrontEnd/Rename.hs 147
-    mapM_ checkExportSpec $ fromMaybe [] (hsModuleExports tidy)
-    return tidy { hsModuleDecls = decls' }
+    --mapM_ checkExportSpec $ fromMaybe [] (hsModuleExports tidy)
+    return mod { hsModuleDecls = decls' }
hunk ./src/FrontEnd/Rename.hs 804
-namesHsConDecl' toName c = ans where
-    dc = (toName DataConstructor $ hsConDeclName c,sl,fls')
-    sl = hsConDeclSrcLoc c
-    ans = dc : [ (toName Val n,sl,[]) |  n <- fls ]  ++  [ (n,sl,[]) |  n <- fls' ]
-    fls' = map (toName FieldLabel) fls
-    fls = case c of
-        HsRecDecl { hsConDeclRecArg = ra } -> concatMap fst ra -- (map (rtup (hsConDeclSrcLoc c). toName FieldLabel) . fst) ra
-        _ -> []
+    namesHsConDecl' toName c = ans where
+        dc = (toName DataConstructor $ hsConDeclName c,sl,fls')
+        sl = hsConDeclSrcLoc c
+        ans = dc : [ (toName Val n,sl,[]) |  n <- fls ]  ++  [ (n,sl,[]) |  n <- fls' ]
+        fls' = map (toName FieldLabel) fls
+        fls = case c of
+            HsRecDecl { hsConDeclRecArg = ra } -> concatMap fst ra -- (map (rtup (hsConDeclSrcLoc c). toName FieldLabel) . fst) ra
+            _ -> []
hunk ./src/FrontEnd/Rename.hs 813
-namesHsDeclTS' toName (HsTypeSig sl ns _) = (map ((,sl) . toName Val) ns)
-namesHsDeclTS' toName (HsTypeDecl sl n _ _) = [(toName TypeConstructor n,sl)]
-namesHsDeclTS' _ _ = []
+    namesHsDeclTS' toName (HsTypeSig sl ns _) = (map ((,sl) . toName Val) ns)
+    namesHsDeclTS' toName (HsTypeDecl sl n _ _) = [(toName TypeConstructor n,sl)]
+    namesHsDeclTS' _ _ = []