[remove all the old 'updateSubTable' code from the renamer
John Meacham <john@repetae.net>**20080218135347] hunk ./FrontEnd/Rename.hs 200
--- The following functions all take a piece of the Haskell syntax tree
--- (as outlined in HsSyn) and uses the provided SubTable to rename it
-
--- Some of the functions have to create a new nested scope which they do
--- by creating a new SubTable using updateSubTableWith* and passing that
--- new table down to its children on the syntax tree.
-
-
-
hunk ./FrontEnd/Rename.hs 209
-        subTable' <- updateSubTableWithHsDecls mempty hsDecls
-        withSubTable subTable' $ do
+        updateWith hsDecls $ do
hunk ./FrontEnd/Rename.hs 217
-        subTable' <- updateSubTableWithHsQualType mempty t
-        withSubTable subTable' $ do
-        t <- rename t
-        return (HsForeignExport a b n t)
+        updateWith t $ do
+            t <- rename t
+            return (HsForeignExport a b n t)
hunk ./FrontEnd/Rename.hs 224
-        subTable' <- updateSubTableWithHsQualType mempty t
-        withSubTable subTable' $ do
+        updateWith t $ do
hunk ./FrontEnd/Rename.hs 235
-        subTable' <- updateSubTableWithHsQualType mempty hsQualType
-        withSubTable subTable' $ do
+        updateWith hsQualType $ do
hunk ./FrontEnd/Rename.hs 241
-        subTable' <- updateSubTableWithHsNames mempty hsNames1
-        withSubTable subTable' $ do
+        updateWith hsNames1 $ do
hunk ./FrontEnd/Rename.hs 251
-        subTable' <- updateSubTableWithHsNames mempty (Set.toList $ freeVars hsNames)
-        withSubTable subTable' $ do
-        --subTable' <- updateSubTableWithHsNames subTable hsNames
-        hsNames' <- rename hsNames
-        t' <- rename t
-        return (HsTypeDecl srcLoc  hsName' hsNames' t')
-
+        updateWith (Set.toList $ freeVars hsNames :: [HsName]) $ do
+            hsNames' <- rename hsNames
+            t' <- rename t
+            return (HsTypeDecl srcLoc  hsName' hsNames' t')
hunk ./FrontEnd/Rename.hs 258
-        subTable' <- updateSubTableWithHsNames mempty hsNames1
-        withSubTable subTable' $ do
+        updateWith hsNames1 $ do
hunk ./FrontEnd/Rename.hs 267
-        startingSubTable <- asks envSubTable
-        {- WAS: typeSigSubTable <- updateSubTableWithHsQualType initialSubTable hsQualType -}
-        typeSigSubTable <- updateSubTableWithHsQualType startingSubTable hsQualType
-        hsQualType' <- withSubTable typeSigSubTable $ rename hsQualType
+        hsQualType' <- updateWith hsQualType  $ rename hsQualType
hunk ./FrontEnd/Rename.hs 273
-        subTable' <- updateSubTableWithHsQualType mempty hsQualType
-        withSubTable subTable' $ do
+        updateWith hsQualType $ do
hunk ./FrontEnd/Rename.hs 300
+    rename (HsDefaultDecl sl e) = HsDefaultDecl sl <$> rename e
+    rename (HsDeclDeriving sl ch) = HsDeclDeriving sl <$> rename ch
+    rename h = error $ "renameerr: " ++ show h
+
hunk ./FrontEnd/Rename.hs 305
+instance Rename HsClassHead where
+    rename (HsClassHead cx n ts) = do
+        updateWith ts $ HsClassHead <$> rename cx <*> renameTypeName n <*> rename ts
+
+    
hunk ./FrontEnd/Rename.hs 314
-        subTable' <- updateSubTableWithHsNames mempty (fsts fvs)
-        withSubTable subTable' $ do
-        subTable'' <- updateSubTableWithHsTypes mempty (catMaybes $ snds fvs)
+        updateWith (fsts fvs) $ do
+        subTable'' <- getUpdates (catMaybes $ snds fvs)
hunk ./FrontEnd/Rename.hs 346
-        subTable' <- updateSubTableWithHsNames mempty (map hsTyVarBindName (hsConDeclExists cd))
-        withSubTable subTable' $ do
+        updateWith  (map hsTyVarBindName (hsConDeclExists cd)) $ do
hunk ./FrontEnd/Rename.hs 354
-        subTable' <- updateSubTableWithHsNames subTable (map hsTyVarBindName (hsConDeclExists cd))
-        withSubTable subTable' $ do
+        updateWith (map hsTyVarBindName (hsConDeclExists cd)) $ do
hunk ./FrontEnd/Rename.hs 381
-        subTable' <- updateSubTableWithHsNames mempty (map hsTyVarBindName ts)
-        withSubTable subTable' $ do
+        updateWith (map hsTyVarBindName ts)  $ do
hunk ./FrontEnd/Rename.hs 386
-        subTable' <- updateSubTableWithHsNames mempty (map hsTyVarBindName ts)
-        withSubTable subTable' $ do
+        updateWith (map hsTyVarBindName ts) $ do
hunk ./FrontEnd/Rename.hs 395
+class UpdateTable a where
+    updateWith :: a -> RM b -> RM b
+    updateWith x action = getUpdates x >>= flip withSubTable action
+
+    getUpdates :: a -> RM SubTable
+    getUpdates x = Map.unions `fmap` mapM clobberName (getNames x)
+
+    getNames :: a -> [HsName]
+    getNames a = [] 
+
+
+instance UpdateTable a => UpdateTable [a] where
+    getUpdates xs = Map.unions `fmap` mapM getUpdates xs
+    getNames xs = concatMap getNames xs
+
+instance UpdateTable HsName where
+    getNames x = [x]
hunk ./FrontEnd/Rename.hs 417
-    updateWith :: a -> RM b -> RM b
-    updateWith _ x = x
hunk ./FrontEnd/Rename.hs 426
-    updateWith [] x = x
-    updateWith (x:xs) action = updateWith x (updateWith xs action)
hunk ./FrontEnd/Rename.hs 451
-    rename m = renameOld $ renameHsMatch m
-
-renameHsMatch :: HsMatch -> SubTable -> RM HsMatch
-renameHsMatch (HsMatch srcLoc hsName hsPats hsRhs {-where-} hsDecls) subTable = do
-    withSrcLoc srcLoc $ do
-    hsName' <- renameHsName hsName subTable
-    subTable' <- updateSubTableWithHsPats subTable hsPats srcLoc
-    withSubTable subTable' $ do
-    hsPats' <- rename hsPats
-    subTable'' <- updateSubTableWithHsDecls subTable' hsDecls
-    withSubTable subTable'' $ do
-    hsDecls' <- rename (expandTypeSigs hsDecls)
-    mapM_ HsErrors.hsDeclLocal hsDecls'
-    hsRhs' <- rename hsRhs
-    return (HsMatch srcLoc hsName' hsPats' hsRhs' {-where-} hsDecls')
-
-
+    rename (HsMatch srcLoc hsName hsPats hsRhs {-where-} hsDecls) = do
+        withSrcLoc srcLoc $ do
+        hsName' <- rename hsName
+        updateWith hsPats  $ do
+        hsPats' <- rename hsPats
+        updateWith hsDecls $ do
+        hsDecls' <- rename (expandTypeSigs hsDecls)
+        mapM_ HsErrors.hsDeclLocal hsDecls'
+        hsRhs' <- rename hsRhs
+        return (HsMatch srcLoc hsName' hsPats' hsRhs' {-where-} hsDecls')
hunk ./FrontEnd/Rename.hs 551
-    subTable' <- updateSubTableWithHsPats subTable hsPats srcLoc
-    withSubTable subTable' $ do
+    updateWith hsPats $ do
hunk ./FrontEnd/Rename.hs 556
-    subTable' <- updateSubTableWithHsDecls subTable hsDecls
-    withSubTable subTable' $ do
+    updateWith hsDecls $ do
hunk ./FrontEnd/Rename.hs 559
-    hsExp' <- renameHsExp hsExp subTable'
+    hsExp' <- rename hsExp
hunk ./FrontEnd/Rename.hs 562
-    hsExp' <- renameHsExp hsExp subTable
+    hsExp' <- rename hsExp
hunk ./FrontEnd/Rename.hs 567
-    renameHsExp e subTable
+    rename e
hunk ./FrontEnd/Rename.hs 607
-    subTable' <- updateSubTableWithHsQualType subTable hsQualType
-    withSubTable subTable' $ do
+    updateWith hsQualType $ do
hunk ./FrontEnd/Rename.hs 674
-        subTable' <- updateSubTableWithHsPats mempty [hsPat] srcLoc
-        withSubTable subTable' $ do
+        updateWith hsPat $ do
hunk ./FrontEnd/Rename.hs 676
-        subTable'' <- updateSubTableWithHsDecls subTable' hsDecls
-        withSubTable subTable'' $ do
+        updateWith hsDecls $ do
hunk ./FrontEnd/Rename.hs 694
-      subTable' <- updateSubTableWithHsStmt subTable hsStmt
+    updateWith hsStmt $ do
+      subTable' <- getUpdates hsStmt
hunk ./FrontEnd/Rename.hs 754
-
-
hunk ./FrontEnd/Rename.hs 758
----------------------------------------
--- utility functions
-
--- clobberHsName(s) is called by the updateSubTableWith* functions to
--- deal with newly declared identifiers
-
--- clobberHsName(s) adds new mappings to the SubTable.
--- If a name already appeared, it's mapping is altered to the new one.
-
--- clobberHsNamesAndUpdateIdentTable also adds a mapping from this
--- renamed name to its source location and binding type
-
-clobberHsNamesAndUpdateIdentTable :: [(HsName,SrcLoc)] -> SubTable -> RM (SubTable)
-clobberHsNamesAndUpdateIdentTable ((hsName,srcLoc):hsNamesAndASrcLocs) subTable = do
-      subTable'  <- clobberHsName hsName subTable
-      subTable'' <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable'
-      return (subTable'')
-clobberHsNamesAndUpdateIdentTable [] subTable = return (subTable)
-
-
--- takes a list of names and a subtable. adds the associations
--- [name -> renamedName] to the table and returns it.
-clobberHsNames :: [HsName] -> SubTable -> RM (SubTable)
-clobberHsNames (hsName:hsNames) subTable = do
-      subTable'  <- clobberHsName  hsName  subTable
-      subTable'' <- clobberHsNames hsNames subTable'
-      return (subTable'')
-clobberHsNames [] subTable = return subTable
-
-clobberHsName :: HsName -> SubTable -> RM (SubTable)
-clobberHsName hsName subTable = do
-      unique     <- newUniq
-      currModule <- getCurrentModule
-      let hsName'     = renameAndQualify hsName unique currModule
-          subTable'   = Map.insert hsName hsName' subTable
-      return (subTable')
-
hunk ./FrontEnd/Rename.hs 812
+instance UpdateTable HsDecl where
+    getNames hsDecl = fsts $  getHsNamesAndASrcLocsFromHsDecl hsDecl
hunk ./FrontEnd/Rename.hs 815
-updateSubTableWithHsDecls :: SubTable -> [HsDecl] ->  RM (SubTable)
-updateSubTableWithHsDecls subTable [] = return subTable
-updateSubTableWithHsDecls subTable (hsDecl:hsDecls) = do
-    let hsNamesAndASrcLocs = getHsNamesAndASrcLocsFromHsDecl hsDecl
-    subTable'  <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable
-    subTable'' <- updateSubTableWithHsDecls subTable' hsDecls
-    return (subTable'')
-
-updateSubTableWithHsPats :: SubTable -> [HsPat] -> SrcLoc -> RM (SubTable)
-updateSubTableWithHsPats subTable (hsPat:hsPats) srcLoc = do
-    let hsNamesAndASrcLocs = zip (getNamesFromHsPat hsPat) (repeat srcLoc)
-    subTable'  <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable
-    subTable'' <- updateSubTableWithHsPats subTable' hsPats srcLoc
-    return subTable''
-updateSubTableWithHsPats subTable [] _srcLoc  = do return (subTable)
-
--- Only one HsStmt should be added at a time because each new identifier is only valid
--- below the point at which it is defined
-
-updateSubTableWithHsStmt :: SubTable -> HsStmt -> RM (SubTable)
-updateSubTableWithHsStmt subTable hsStmt = do
-    let hsNamesAndASrcLocs = getHsNamesAndASrcLocsFromHsStmt hsStmt
-    subTable' <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable
-    return (subTable')
+instance UpdateTable HsPat where
+    getNames hsPat = getNamesFromHsPat hsPat
hunk ./FrontEnd/Rename.hs 818
-----------------------------------------------------------
--- the following updateSubTableWith* functions do not need to alter the identTable aswell
---
-
-
--- takes a list of HsNames representing type variables in a data decl and
--- adds them to the current subTable
-
-updateSubTableWithHsNames :: SubTable -> [HsName] -> RM (SubTable)
-updateSubTableWithHsNames subTable hsNames = clobberHsNames hsNames subTable
-
--- takes an HsQualType (a type signature) and adds the names of its variables
--- to the current subTable
-
-updateSubTableWithHsQualType :: SubTable -> HsQualType -> RM (SubTable)
-updateSubTableWithHsQualType subTable hsQualType = do
-      let hsNames = nub $ getHsNamesFromHsQualType hsQualType
-      subTable' <- clobberHsNames hsNames subTable
-      return (subTable')
-
-updateSubTableWithHsTypes :: SubTable -> [HsType] -> RM (SubTable)
-updateSubTableWithHsTypes subTable hsType = do
-      let hsNames = nub $ concatMap getHsNamesFromHsType hsType
-      subTable' <- clobberHsNames hsNames subTable
-      return (subTable')
+instance UpdateTable HsStmt where
+    getNames hsStmt = fsts $  getHsNamesAndASrcLocsFromHsStmt hsStmt
hunk ./FrontEnd/Rename.hs 864
-            --       | otherwise ->  parseName ClassName (show x ++ show (nameType x))
+            _ -> error "not a class name"
hunk ./FrontEnd/Rename.hs 895
+        _ -> error "really not a class name"
hunk ./FrontEnd/Rename.hs 905
--- _hsNames that are constructors can be ignored.
-
-
hunk ./FrontEnd/Rename.hs 911
--- the getNew... functions are used only inside class declarations to avoid _re_ renaming things
--- that should be left as is.
-
-
-getHsNamesFromHsQualType :: HsQualType -> [HsName]
-getHsNamesFromHsQualType (HsQualType _hsContext hsType) = getHsNamesFromHsType hsType
-
-getHsNamesFromHsType :: HsType -> [HsName]
-getHsNamesFromHsType t = execWriter (getNamesFromType t)
-getNamesFromType (HsTyVar hsName) = tell [hsName]
-getNamesFromType t = traverseHsType_ getNamesFromType t
--- XXX getHsNamesFromHsType (HsTyForall _bs t) = getHsNamesFromHsQualType t -- TODO, scoping?
--- XXX getHsNamesFromHsType (HsTyExists _bs t) = getHsNamesFromHsQualType t -- TODO, scoping?
-
-
-
+instance UpdateTable HsQualType where
+    getNames (HsQualType _hsContext hsType) = getNames hsType
hunk ./FrontEnd/Rename.hs 914
---------------------------------------------------------------------------------
+instance UpdateTable HsType where
+    getNames t = execWriter (getNamesFromType t)  where
+        getNamesFromType (HsTyVar hsName) = tell [hsName]
+        getNamesFromType t = traverseHsType_ getNamesFromType t