[lots of cleanups in FrontEnd.Rename
John Meacham <john@repetae.net>**20060408021959] hunk ./FrontEnd/Rename.hs 182
- {-
-collectRenameHsSyns ::  SubTable -> [HsDecl] -> ScopeSM [HsDecl]
-collectRenameHsSyns sub (d@(HsTypeDecl sl name args ty):ds) = liftM2 (:) (renameHsTypeDecl sub sl name args ty) (collectRenameHsSyns sub ds)
-collectRenameHsSyns sub (_:ds) = (collectRenameHsSyns sub ds)
-collectRenameHsSyns sub [] = []
-
-renameHsTypeDecl sub sl name args ty = do
-    setSrcLoc sl
-    hsName' <- renameHsName name subTable
-    subTable' <- updateSubTableWithHsNames subTable hsNames
-    hsNames' <- renameHsNames hsNames subTable'
-    t' <- renameHsType t subTable'
-    return (HsTypeDecl srcLoc  hsName' hsNames' t')
--}
-
hunk ./FrontEnd/Rename.hs 235
-
-{-
--- takes a list of qualified HsNames that the current module needs to know
--- about (i.e. ones imported from Prelude), and then in the renaming process
--- any of those names appearing in unqualified form will get qualified
--- e.g. we pass in [Qual (Module "Prelude") "take"] and then in code we see
--- foo = take 3 [1..10], so we translate this to (something like)
--- Main.foo = Prelude.take 3 [1..10]
-renameTidyModule :: [HsDecl] -> [HsName] -> [HsName] -> HsModule -> (HsModule, [Warning])
-renameTidyModule syns importedNames impTypeNames tidyMod
-    = mapSnd errors z {- (renamedTidyMod, errors finalState) -} where
-    initialGlobalSubTable :: SubTable
-    initialGlobalSubTable = listToFM (map makeTranslation importedNames)
-    initialTypeSubTable = listToFM (map makeTranslation impTypeNames)
-    makeTranslation qname@(Qual _ str) = (UnQual str, qname)
-    makeTranslation unqname = error $ "renameTidyModule passed an unqualified importedName " ++ show unqname
-
-    startState = ScopeState {
-        typeSubTable   = initialTypeSubTable,
-        errorTable     = emptyFM,
-        errors         = [],
-        synonyms       = syns,
-        srcLoc         = bogusASrcLoc,
-        unique         = 1,   -- start the counting at 1
-        globalSubTable = initialGlobalSubTable,
-        currentModule  = hsModuleName tidyMod
-        }
-
-    z@(renamedTidyMod, finalState) = runScopeSM startState (renameDecls tidyMod initialGlobalSubTable)
--}
-
hunk ./FrontEnd/Rename.hs 280
-    subTable' <- updateSubTableWithHsDecls subTable hsDecls LetFun
+    subTable' <- updateSubTableWithHsDecls subTable hsDecls
hunk ./FrontEnd/Rename.hs 525
-    subTable' <- updateSubTableWithHsPats subTable hsPats srcLoc FunPat
+    subTable' <- updateSubTableWithHsPats subTable hsPats srcLoc
hunk ./FrontEnd/Rename.hs 527
-    subTable'' <- updateSubTableWithHsDecls subTable' hsDecls WhereFun
+    subTable'' <- updateSubTableWithHsDecls subTable' hsDecls
hunk ./FrontEnd/Rename.hs 584
-{-
-renameHsPatField (HsPFieldPun hsName) subTable
-  = do
-      hsName' <- renameHsName hsName subTable
-      return (HsPFieldPun hsName')
--}
hunk ./FrontEnd/Rename.hs 656
-    subTable' <- updateSubTableWithHsPats subTable hsPats srcLoc LamPat
+    subTable' <- updateSubTableWithHsPats subTable hsPats srcLoc
hunk ./FrontEnd/Rename.hs 661
-    subTable' <- updateSubTableWithHsDecls subTable hsDecls LetFun
+    subTable' <- updateSubTableWithHsDecls subTable hsDecls
hunk ./FrontEnd/Rename.hs 792
-    subTable' <- updateSubTableWithHsPats subTable [hsPat] srcLoc CasePat
+    subTable' <- updateSubTableWithHsPats subTable [hsPat] srcLoc
hunk ./FrontEnd/Rename.hs 794
-    subTable'' <- updateSubTableWithHsDecls subTable' hsDecls WhereFun
+    subTable'' <- updateSubTableWithHsDecls subTable' hsDecls
hunk ./FrontEnd/Rename.hs 900
-clobberHsNamesAndUpdateIdentTable :: [(HsName,SrcLoc)] -> SubTable -> Binding -> ScopeSM (SubTable)
-clobberHsNamesAndUpdateIdentTable ((hsName,srcLoc):hsNamesAndASrcLocs) subTable binding = do
+clobberHsNamesAndUpdateIdentTable :: [(HsName,SrcLoc)] -> SubTable -> ScopeSM (SubTable)
+clobberHsNamesAndUpdateIdentTable ((hsName,srcLoc):hsNamesAndASrcLocs) subTable = do
hunk ./FrontEnd/Rename.hs 903
-      subTable'' <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable' binding
+      subTable'' <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable'
hunk ./FrontEnd/Rename.hs 905
-clobberHsNamesAndUpdateIdentTable [] subTable _binding = return (subTable)
+clobberHsNamesAndUpdateIdentTable [] subTable = return (subTable)
hunk ./FrontEnd/Rename.hs 924
-clobberHsNames (hsName:hsNames) subTable
-  = do
+clobberHsNames (hsName:hsNames) subTable = do
hunk ./FrontEnd/Rename.hs 928
-clobberHsNames [] subTable
-  = return subTable
+clobberHsNames [] subTable = return subTable
hunk ./FrontEnd/Rename.hs 931
-clobberHsName hsName subTable
-  = do
+clobberHsName hsName subTable = do
hunk ./FrontEnd/Rename.hs 987
-updateSubTableWithHsDecls :: SubTable -> [HsDecl] -> Binding -> ScopeSM (SubTable)
-updateSubTableWithHsDecls subTable [] _binding = return subTable
-updateSubTableWithHsDecls subTable (hsDecl:hsDecls) binding = do
+updateSubTableWithHsDecls :: SubTable -> [HsDecl] ->  ScopeSM (SubTable)
+updateSubTableWithHsDecls subTable [] = return subTable
+updateSubTableWithHsDecls subTable (hsDecl:hsDecls) = do
hunk ./FrontEnd/Rename.hs 991
-    subTable'  <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable binding
-    subTable'' <- updateSubTableWithHsDecls subTable' hsDecls binding
+    subTable'  <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable
+    subTable'' <- updateSubTableWithHsDecls subTable' hsDecls
hunk ./FrontEnd/Rename.hs 995
-updateSubTableWithHsPats :: SubTable -> [HsPat] -> SrcLoc -> Binding -> ScopeSM (SubTable)
-updateSubTableWithHsPats subTable (hsPat:hsPats) srcLoc binding = do
+updateSubTableWithHsPats :: SubTable -> [HsPat] -> SrcLoc -> ScopeSM (SubTable)
+updateSubTableWithHsPats subTable (hsPat:hsPats) srcLoc = do
hunk ./FrontEnd/Rename.hs 998
-    subTable'  <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable binding
-    subTable'' <- updateSubTableWithHsPats subTable' hsPats srcLoc binding
+    subTable'  <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable
+    subTable'' <- updateSubTableWithHsPats subTable' hsPats srcLoc
hunk ./FrontEnd/Rename.hs 1001
-updateSubTableWithHsPats subTable [] _srcLoc _binding = do return (subTable)
+updateSubTableWithHsPats subTable [] _srcLoc  = do return (subTable)
hunk ./FrontEnd/Rename.hs 1009
-    subTable' <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable GenPat
+    subTable' <- clobberHsNamesAndUpdateIdentTable hsNamesAndASrcLocs subTable
hunk ./FrontEnd/Rename.hs 1161
-getHsNamesFromHsPat :: HsPat -> [HsName]
-getHsNamesFromHsPat (HsPVar hsName) = [hsName]
-getHsNamesFromHsPat (HsPLit _hsName) = []
-getHsNamesFromHsPat (HsPNeg hsPat) = getHsNamesFromHsPat hsPat
--- _hsName can be ignored as it is a Constructor (e.g. in (x:xs) we only want to know what's in scope; that is x and xs)
-getHsNamesFromHsPat (HsPInfixApp hsPat1 _hsName hsPat2) = getHsNamesFromHsPat hsPat1 ++ getHsNamesFromHsPat hsPat2
-getHsNamesFromHsPat (HsPApp _hsName hsPats) = concat (map getHsNamesFromHsPat hsPats)
-getHsNamesFromHsPat (HsPTuple hsPats) = concat (map getHsNamesFromHsPat hsPats)
-getHsNamesFromHsPat (HsPList hsPats) = concat (map getHsNamesFromHsPat hsPats)
-getHsNamesFromHsPat (HsPParen hsPat) = getHsNamesFromHsPat hsPat
-getHsNamesFromHsPat (HsPRec _hsName hsPatFields) = concat $ map getHsNamesFromHsPatField hsPatFields -- hsName can be ignored as it is a Constructor
-getHsNamesFromHsPat (HsPAsPat hsName hsPat) = hsName:(getHsNamesFromHsPat hsPat)
-getHsNamesFromHsPat (HsPWildCard) = []
-getHsNamesFromHsPat (HsPIrrPat hsPat) = getHsNamesFromHsPat hsPat
+-- _hsNames that are constructors can be ignored.
hunk ./FrontEnd/Rename.hs 1163
--- the hsName can be ignored as it is the field name and must already be in scope
-getHsNamesFromHsPatField :: HsPatField -> [HsName]
-{-
-getHsNamesFromHsPatField (HsPFieldPun _hsName)
-  = []
-  -}
-getHsNamesFromHsPatField (HsPFieldPat _hsName hsPat)
-  = getHsNamesFromHsPat hsPat
+getHsNamesFromHsPat :: HsPat -> [HsName]
+getHsNamesFromHsPat p = execWriter (getNamesFromPat p)  []
+getNamesFromPat (HsPVar hsName) = tell (hsName:)
+getNamesFromPat (HsPAsPat hsName hsPat) = do
+    tell (hsName:)
+    getNamesFromPat hsPat
+getNamesFromPat p = traverseHsPat_ getNamesFromPat p
hunk ./FrontEnd/Rename.hs 1204
-getHsNamesFromHsType (HsTyFun hsType1 hsType2) = (getHsNamesFromHsType hsType1) ++ (getHsNamesFromHsType hsType2)
-getHsNamesFromHsType (HsTyTuple hsTypes) = concat $ map getHsNamesFromHsType hsTypes
-getHsNamesFromHsType (HsTyApp hsType1 hsType2) = (getHsNamesFromHsType hsType1) ++ (getHsNamesFromHsType hsType2)
-getHsNamesFromHsType (HsTyVar hsName) = [hsName]
-getHsNamesFromHsType (HsTyCon _hsName) = [] -- don't rename the Constructors
-getHsNamesFromHsType (HsTyForall _bs t) = getHsNamesFromHsQualType t -- TODO, scoping?
-getHsNamesFromHsType (HsTyExists _bs t) = getHsNamesFromHsQualType t -- TODO, scoping?
+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?
hunk ./FrontEnd/Rename.hs 1214
-getHsNamesFromClass (HsClassDecl _srcLoc _hsQualType hsDecls)
-  = getHsNamesFromTypeSigs hsDecls
-getHsNamesFromClass _otherDecl
-  = []
+getHsNamesFromClass (HsClassDecl _srcLoc _hsQualType hsDecls) = getHsNamesFromTypeSigs hsDecls
+getHsNamesFromClass _otherDecl = []
hunk ./FrontEnd/Rename.hs 1220
-getHsNamesFromTypeSigs ((HsTypeSig _srcLoc hsNames _hsQualType):hsDecls)
-  = hsNames ++ getHsNamesFromTypeSigs hsDecls
-getHsNamesFromTypeSigs (_otherDecl:hsDecls)
-  = getHsNamesFromTypeSigs hsDecls
-getHsNamesFromTypeSigs []
-  = []
+getHsNamesFromTypeSigs ((HsTypeSig _srcLoc hsNames _hsQualType):hsDecls) = hsNames ++ getHsNamesFromTypeSigs hsDecls
+getHsNamesFromTypeSigs (_otherDecl:hsDecls) = getHsNamesFromTypeSigs hsDecls
+getHsNamesFromTypeSigs [] = []
hunk ./FrontEnd/Rename.hs 1552
--- Ident table stuff
-type IdentTable = FiniteMap HsName (SrcLoc, Binding)
-addToIdentTable _ _ = return ()
-
-data Binding
-   = TopFun             -- function binding at the top level
-   | ClassMethod        -- name of a method in a class
-   | Instance           -- an instance decl lifted to a top-level binding
-   | WhereFun           -- function binding in a where clause
-   | LetFun             -- function binding in a let expression (used to include topbinds too)
-   | LamPat             -- pattern binding in a lambda expression
-   | CasePat            -- pattern binding in a case expression
-   | GenPat             -- pattern binding in a generator statement
-   | FunPat             -- pattern binding in a function declaration
-   | Constr             -- name is a data constructor
-
+type Binding = ()
hunk ./FrontEnd/Syn/Traverse.hs 129
+traverseHsType_ fn p = traverseHsType (traverse_ fn) p >> return ()
hunk ./FrontEnd/Syn/Traverse.hs 151
+traverseHsPat_ fn p = traverseHsPat (traverse_ fn) p >> return ()