[add support for explicit kinds to the parser, add # as a valid kind, add explicit kinds to HsType, HsDataDecl, clean up a lot of traversal code
John Meacham <john@repetae.net>**20061109235437] hunk ./DerivingDrift/Drift.hs 50
-driftDerive' (HsDataDecl sloc cntxt name args condecls derives) = do
+driftDerive' HsDataDecl { hsDeclName = name, hsDeclArgs = args, hsDeclCons = condecls, hsDeclDerives = derives } = do
hunk ./FrontEnd/DataConsAssump.hs 50
-dataDeclEnv modName kt (HsDataDecl _sloc context typeName args condecls _)
+dataDeclEnv modName kt HsDataDecl { hsDeclContext = context, hsDeclName = typeName, hsDeclArgs = args, hsDeclCons = condecls }
hunk ./FrontEnd/Desugar.hs 183
-desugarDecl (HsDataDecl sloc cntxt name args condecls derives) = do
+desugarDecl dl@HsDataDecl { hsDeclSrcLoc = sloc, hsDeclName =  name, hsDeclArgs = args, hsDeclCons = condecls, hsDeclDerives = derives } = do
hunk ./FrontEnd/Desugar.hs 188
-        return $ (HsDataDecl sloc cntxt name args newConDecls derives):(ds ++ ss)
+        return $ dl:(ds ++ ss)
hunk ./FrontEnd/Desugar.hs 190
-desugarDecl (HsNewTypeDecl sloc cntxt name args condecl derives) = do
+desugarDecl dl@(HsNewTypeDecl sloc cntxt name args condecl derives) = do
hunk ./FrontEnd/Desugar.hs 195
-        return $ (HsNewTypeDecl sloc cntxt name args newConDecl derives):(ds ++ ss)
+        return $ dl:(ds ++ ss)
hunk ./FrontEnd/HsParser.y 94
+      '#'     { Hash }
hunk ./FrontEnd/HsParser.y 279
-             returnP (HsDataDecl $3 cs c t [] $4) }
+             returnP hsDataDecl { hsDeclSrcLoc = $3, hsDeclContext = cs, hsDeclName = c, hsDeclArgs = t, hsDeclDerives = $4 } }
+      | 'data' ctype '::' kind srcloc deriving
+          {% checkDataHeader $2 `thenP` \(cs,c,t) ->
+             returnP hsDataDecl { hsDeclSrcLoc = $5, hsDeclContext = cs, hsDeclName = c, hsDeclArgs = t, hsDeclDerives = $6, hsDeclHasKind = Just $4 } }
hunk ./FrontEnd/HsParser.y 285
-                         returnP (HsDataDecl $3 cs c t (reverse $5) $6) }
+                         returnP hsDataDecl { hsDeclSrcLoc = $3, hsDeclContext = cs, hsDeclName = c, hsDeclArgs = t, hsDeclDerives = $6, hsDeclCons = reverse $5 } }
hunk ./FrontEnd/HsParser.y 410
+       |  '#'                   { hsKindHash }
+       |  qconid                { HsKind $1 }
hunk ./FrontEnd/HsParser.y 425
-      | '(' type ')'                  { $2 }
+      | '(' ktype ')'                 { $2 }
hunk ./FrontEnd/HsParser.y 428
+ktype :: { HsType }
+    : srcloc atype '::' kind { HsTyExpKind { hsTySrcLoc = $1, hsTyType = $2, hsTyKind = $4 } }
+    | type                  { $1 }
+
hunk ./FrontEnd/HsParser.y 843
+      | '#'                   { hash_name }
hunk ./FrontEnd/HsParser.y 850
+      | '#'                   { hash_name }
hunk ./FrontEnd/HsPretty.hs 37
+import Doc.DocLike(TextLike(..),DocLike(..))
hunk ./FrontEnd/HsPretty.hs 109
-empty :: Doc
-empty = return P.empty
hunk ./FrontEnd/HsPretty.hs 117
+instance DL.TextLike Doc where
+    empty = return P.empty
+    text = return . P.text
+    char = return . P.char
hunk ./FrontEnd/HsPretty.hs 122
-text, ptext :: String -> Doc
-text = return . P.text
-ptext = return . P.text
hunk ./FrontEnd/HsPretty.hs 123
-char :: Char -> Doc
-char = return . P.char
hunk ./FrontEnd/HsPretty.hs 168
+--
+instance DocLike Doc where
+    aM <> bM = do{a<-aM;b<-bM;return (a P.<> b)}
+    aM <+> bM = do{a<-aM;b<-bM;return (a P.<+> b)}
+    aM <$> bM = do{a<-aM;b<-bM;return (a P.$$ b)}
+    hcat dl = sequence dl >>= return . P.hcat
+    hsep dl = sequence dl >>= return . P.hsep
+    vcat dl = sequence dl >>= return . P.vcat
hunk ./FrontEnd/HsPretty.hs 177
-(<>),(<+>),($$),($+$) :: Doc -> Doc -> Doc
-aM <> bM = do{a<-aM;b<-bM;return (a P.<> b)}
-aM <+> bM = do{a<-aM;b<-bM;return (a P.<+> b)}
+($$),($+$) :: Doc -> Doc -> Doc
hunk ./FrontEnd/HsPretty.hs 181
-hcat,hsep,vcat,sep,cat,fsep,fcat :: [Doc] -> Doc
-hcat dl = sequence dl >>= return . P.hcat
-hsep dl = sequence dl >>= return . P.hsep
-vcat dl = sequence dl >>= return . P.vcat
+
+sep,cat,fsep,fcat :: [Doc] -> Doc
hunk ./FrontEnd/HsPretty.hs 287
-ppHsDecl (HsDataDecl loc context name nameList constrList derives) =
+ppHsDecl HsDataDecl { hsDeclContext = context, hsDeclName = name, hsDeclArgs = nameList, hsDeclCons = constrList, hsDeclDerives = derives } =
hunk ./FrontEnd/HsPretty.hs 433
+ppHsTypePrec _ HsTyExpKind { hsTyType = t, hsTyKind = k } = do
+    t <- ppHsType t
+    return $ DL.parens ( t DL.<+> DL.text "::" DL.<+> pprint k)
+
+instance DL.DocLike d => P.PPrint d HsKind where
+    pprint (HsKind k) = pprint k
+    pprint (HsKindFn (HsKind k) t) = pprint k DL.<+> DL.text "->" DL.<+> pprint t
+    pprint (HsKindFn a b) = DL.parens (pprint a) DL.<+> DL.text "->" DL.<+> pprint b
hunk ./FrontEnd/HsPretty.hs 602
-	 | m == prelude_mod && isSpecialName z = ppHsIdentifier name
hunk ./FrontEnd/HsPretty.hs 607
-ppHsQNameParen name = parensIf (isSymbolName (getName name)) (ppHsQName name)
+ppHsQNameParen name = parensIf (isSymbolName name) (ppHsQName name)
hunk ./FrontEnd/HsPretty.hs 611
-	| isSymbolName (getName name) = ppHsQName name
+	| isSymbolName name = ppHsQName name
hunk ./FrontEnd/HsPretty.hs 631
-isSpecialName :: HsName -> Bool
---isSpecialName (Qual _ (HsSpecial _)) = True
---isSpecialName (UnQual (HsSpecial _)) = True
-isSpecialName _ = False
-
-getName :: HsName -> HsName
---getName (UnQual s) = s
---getName (Qual _ s) = s
-getName = id
hunk ./FrontEnd/HsSyn.hs 23
+    srcLoc HsError { hsExpSrcLoc = sl } = sl
hunk ./FrontEnd/HsSyn.hs 145
+hsDataDecl = HsDataDecl {
+    hsDeclSrcLoc = bogusASrcLoc,
+    hsDeclContext = [],
+    hsDeclName = error "hsDataDecl.hsDeclName",
+    hsDeclArgs = [],
+    hsDeclCons = [],
+    hsDeclHasKind = Nothing,
+    hsDeclDerives = []
+    }
+
+hsNewTypeDecl = HsNewTypeDecl {
+    hsDeclSrcLoc = bogusASrcLoc,
+    hsDeclContext = [],
+    hsDeclName = error "hsNewTypeDecl.hsDeclName",
+    hsDeclArgs = [],
+    hsDeclCon = error "hsNewTypeDecl.hsDeclCon",
+    hsDeclDerives = []
+    }
+
hunk ./FrontEnd/HsSyn.hs 166
-	 | HsDataDecl	 { hsDeclSrcLoc :: SrcLoc, hsDeclContext :: HsContext, hsDeclName :: HsName, hsDeclArgs :: [HsName], hsDeclCons :: [HsConDecl], {- deriving -} hsDeclDerives :: [HsName] }
+	 | HsDataDecl	 {
+            hsDeclSrcLoc :: SrcLoc,
+            hsDeclContext :: HsContext,
+            hsDeclName :: HsName,
+            hsDeclArgs :: [HsName],
+            hsDeclCons :: [HsConDecl],
+            hsDeclHasKind :: Maybe HsKind,
+            {- deriving -} hsDeclDerives :: [HsName]
+            }
+	 | HsNewTypeDecl {
+            hsDeclSrcLoc :: SrcLoc,
+            hsDeclContext :: HsContext,
+            hsDeclName :: HsName,
+            hsDeclArgs :: [HsName],
+            hsDeclCon :: HsConDecl,
+            {- deriving -} hsDeclDerives :: [HsName]
+            }
hunk ./FrontEnd/HsSyn.hs 184
-	 | HsNewTypeDecl { hsDeclSrcLoc :: SrcLoc, hsDeclContext :: HsContext, hsDeclName :: HsName, hsDeclArgs :: [HsName], hsDeclCon :: HsConDecl, {- deriving -} hsDeclDerives :: [HsName] }
hunk ./FrontEnd/HsSyn.hs 199
+         | HsDeclDeriving { hsDeclSrcLoc :: SrcLoc, hsDeclQualType :: HsQualType }
hunk ./FrontEnd/HsSyn.hs 264
+         | HsTyExpKind { hsTySrcLoc :: SrcLoc, hsTyType :: HsType, hsTyKind :: HsKind }
hunk ./FrontEnd/HsSyn.hs 386
-data HsKind = HsKind {-# UNPACK #-} !Atom | HsKindFn HsKind HsKind
+data HsKind = HsKind HsName | HsKindFn HsKind HsKind
hunk ./FrontEnd/HsSyn.hs 390
-hsKindStar = HsKind (fromString "*")
+hsKindStar = HsKind (Qual (Module "Jhc@") (HsIdent "*"))
+hsKindHash = HsKind (Qual (Module "Jhc@") (HsIdent "#"))
hunk ./FrontEnd/HsSyn.hs 399
---unit_con_name	      = Qual prelude_mod (HsSpecial "()")
hunk ./FrontEnd/HsSyn.hs 400
---tuple_con_name i      = Qual prelude_mod (HsIdent ("("++replicate i ','++")"))
hunk ./FrontEnd/HsSyn.hs 411
+hash_name	      = UnQual $ HsIdent "#"
hunk ./FrontEnd/HsSyn.hs 417
---list_tycon_name       = Qual prelude_mod (HsIdent "[]")
hunk ./FrontEnd/KindInfer.hs 291
+kiType k HsTyExpKind { hsTyType = t, hsTyKind = ek } = do
+    unify (hsKindToKind ek) k
+    kiType' k t
hunk ./FrontEnd/KindInfer.hs 309
+-- hsKindToKind (HsKind n) = toName SortName n
hunk ./FrontEnd/KindInfer.hs 440
+aHsTypeToType kt HsTyExpKind { hsTyType = t } = aHsTypeToType kt t
hunk ./FrontEnd/Lexer.hs 80
+	| Hash
hunk ./FrontEnd/Lexer.hs 147
- ( "*",  Star )		--ditto
+ ( "*",  Star ),	--ditto
+ ( "#",  Hash )		--ditto
hunk ./FrontEnd/Rename.hs 324
-renameHsDecl (HsDataDecl srcLoc hsContext hsName hsNames1 hsConDecls hsNames2) subTable = do
+renameHsDecl dl@HsDataDecl { hsDeclSrcLoc = srcLoc, hsDeclContext = hsContext, hsDeclName = hsName, hsDeclArgs = hsNames1, hsDeclCons = hsConDecls, hsDeclDerives = hsNames2 } subTable = do
hunk ./FrontEnd/Rename.hs 333
-    return (HsDataDecl srcLoc hsContext' hsName' hsNames1' hsConDecls' hsNames2')
+    return dl { hsDeclContext = hsContext', hsDeclName = hsName', hsDeclArgs = hsNames1', hsDeclCons = hsConDecls', hsDeclDerives = hsNames2' }
hunk ./FrontEnd/Rename.hs 1120
-    f (HsDataDecl sl _ n _ cs _) = do tellF $ (toName TypeConstructor n,sl,snub [ x |(x,_,_) <- cs']): cs' ; zup cs where
+    f HsDataDecl { hsDeclSrcLoc =sl, hsDeclName = n, hsDeclCons = cs } = do tellF $ (toName TypeConstructor n,sl,snub [ x |(x,_,_) <- cs']): cs' ; zup cs where
hunk ./FrontEnd/Rename.hs 1177
-namesHsDecl (HsDataDecl sl _ n _ cs _) = ( (concatMap namesHsConDecl cs) ,[(n,sl)])
+namesHsDecl HsDataDecl { hsDeclSrcLoc = sl, hsDeclName = n, hsDeclCons = cs } = ( (concatMap namesHsConDecl cs) ,[(n,sl)])
hunk ./FrontEnd/Rename.hs 1257
--- the Renameable class
-
-
--- stores the instance Renameable for all of HsSyn
-
-class Renameable a where
-    replaceName :: (HsName -> HsName) -> a -> a
-
-instance Renameable SrcLoc where
-    replaceName f = id
-
-instance Renameable HsExportSpec where
-    replaceName f hsexportspec
-      = let a # b = a $ (replaceName f b)
-        in case hsexportspec of
-            HsEVar  name               ->
-                HsEVar  # name
-            HsEAbs  name               ->
-                HsEAbs  # name
-            HsEThingAll  name		 ->
-                HsEThingAll  # name
-            HsEThingWith  name names	 ->
-                HsEThingWith  # name # names
-            HsEModuleContents mod	 ->
-                HsEModuleContents mod
-
-instance Renameable HsAsst where
-    replaceName f (HsAsst x xs) = HsAsst (replaceName f x) (replaceName f xs)
-    replaceName f (HsAsstEq x y) = HsAsstEq (replaceName f x) (replaceName f y)
-
-instance Renameable HsImportDecl where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-            a $$ b = a b
-            infixl 0 $$
-        in case object of
-            HsImportDecl  srcloc mod bool maybe1 maybe2 ->
-                HsImportDecl # srcloc $$ mod $$ bool $$ maybe1 $$ maybe2'
-                where maybe2' = fmap (\(b,importSpec) -> (b, replaceName f importSpec)) maybe2
-
-
-instance Renameable HsImportSpec where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsIVar  name			 ->
-                HsIVar  # name
-            HsIAbs  name			 ->
-                HsIAbs  # name
-            HsIThingAll  name		 ->
-                HsIThingAll  # name
-            HsIThingWith  name names	 ->
-                HsIThingWith  # name # names
-
-
-{-
-instance Renameable HsInfixDecl where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsInfixDecl  srcloc fixity names ->
-                HsInfixDecl  # srcloc # fixity # names
--}
-
-
-{-
-instance Renameable HsFixity where
-    replaceName f = id
--}
-
-instance Renameable HsAssoc where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsAssocNone  ->
-                HsAssocNone
-            HsAssocLeft  ->
-                HsAssocLeft
-            HsAssocRight  ->
-                HsAssocRight
-
-
-instance Renameable (HsDecl) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsTypeDecl 	srcloc name names typ ->
-                HsTypeDecl 	srcloc # name # names # typ
-            HsDataDecl 	srcloc context name names condecls names' ->
-                HsDataDecl 	srcloc # context # name # names # condecls # names'
-            HsNewTypeDecl 	srcloc context name names condecl names' ->
-                HsNewTypeDecl 	srcloc # context # name # names # condecl # names'
-            HsClassDecl 	srcloc qualtyp objects ->
-                HsClassDecl 	srcloc # qualtyp # objects
-            HsInstDecl 	srcloc qualtyp objects ->
-                HsInstDecl 	srcloc # qualtyp # objects
-            HsDefaultDecl 	srcloc typ ->
-                HsDefaultDecl 	srcloc # typ
-            HsTypeSig 	srcloc names qualtyp ->
-                HsTypeSig 	srcloc # names # qualtyp
-            -- HsFunBind       srcloc matc ->
-            HsFunBind          matc ->
-                -- HsFunBind  # srcloc # matc
-                HsFunBind  # matc
-            HsPatBind 	srcloc pat r {-where-} objects ->
-                HsPatBind 	srcloc # pat # r # objects
-            od -> od
-
-
-instance Renameable (HsMatch) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsMatch  srcloc name pats r {-where-} objects ->
-                HsMatch  # srcloc # name # pats # r # objects
-
-
-instance Renameable HsConDecl where
-    replaceName f = hsConDeclExists_u (replaceName f) . hsConDeclName_u (replaceName f) . hsConDeclRecArg_u (replaceName f) . hsConDeclConArg_u (replaceName f)
---    replaceName f object
---      = let a # b = a $ (replaceName f b)
---        in case object of
---            HsConDecl  srcloc name bangtyps ->
---                HsConDecl  # srcloc # name # bangtyps
---            HsRecDecl  srcloc name names_and_bangtyp ->
---                HsRecDecl  # srcloc # name # names_and_bangtyp
-
-
-
-
-instance Renameable HsBangType where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsBangedTy    typ ->
-                HsBangedTy  # typ
-            HsUnBangedTy  typ ->
-                HsUnBangedTy  # typ
-
-
-instance Renameable (HsRhs) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsUnGuardedRhs  exp ->
-                HsUnGuardedRhs  # exp
-            HsGuardedRhss   guardedrs ->
-                HsGuardedRhss  # guardedrs
-
-
-instance Renameable (HsGuardedRhs) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsGuardedRhs  srcloc exp exp' ->
-                HsGuardedRhs  # srcloc # exp # exp'
-
-
-instance Renameable HsQualType where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsQualType    context typ ->
-                HsQualType  # context # typ
-
-
-instance Renameable HsType where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsTyFun    typ typ' ->
-                HsTyFun  # typ # typ'
-            HsTyTuple  typs ->
-                HsTyTuple  # typs
-            HsTyUnboxedTuple  typs ->
-                HsTyUnboxedTuple  # typs
-            HsTyApp    typ typ' ->
-                HsTyApp  # typ # typ'
-            HsTyVar    name ->
-                HsTyVar  # name
-            HsTyCon    name ->
-                HsTyCon  # name
-
-instance Renameable HsLiteral where
-    replaceName f = id
-
-instance Renameable (HsExp) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            -- HsVar  name ann -> HsVar (replaceName f name) ann
-            HsVar  name -> HsVar (replaceName f name)
-            HsCon  name ->
-                HsCon  # name
-            HsLit  literal ->
-                HsLit  # literal
-            HsInfixApp  exp exp' exp'' ->
-                HsInfixApp  # exp # exp' # exp''
-            HsApp  exp exp' ->
-                HsApp  # exp # exp'
-            HsNegApp  exp ->
-                HsNegApp  # exp
-            HsLambda  srcloc pats exp ->
-                HsLambda  # srcloc # pats # exp
-            HsLet  objects exp ->
-                HsLet  # objects # exp
-            HsIf  exp exp' exp'' ->
-                HsIf  # exp # exp' # exp''
-            HsCase  exp alts ->
-                HsCase  # exp # alts
-            HsDo  stmts ->
-                HsDo  # stmts
-            HsTuple  exps ->
-                HsTuple  # exps
-            HsUnboxedTuple  exps ->
-                HsUnboxedTuple  # exps
-            HsList  exps ->
-                HsList  # exps
-            HsParen  exp ->
-                HsParen  # exp
-            HsLeftSection  exp exp' ->
-                HsLeftSection  # exp # exp'
-            HsRightSection  exp exp' ->
-                HsRightSection  # exp # exp'
-            HsRecConstr  name fieldupdates ->
-                HsRecConstr  # name # fieldupdates
-            HsRecUpdate  exp fieldupdates ->
-                HsRecUpdate  # exp # fieldupdates
-            HsEnumFrom  exp ->
-                HsEnumFrom  # exp
-            HsEnumFromTo  exp exp' ->
-                HsEnumFromTo  # exp # exp'
-            HsEnumFromThen  exp exp' ->
-                HsEnumFromThen  # exp # exp'
-            HsEnumFromThenTo  exp exp' exp'' ->
-                HsEnumFromThenTo  # exp # exp' # exp''
-            HsListComp  exp stmts ->
-                HsListComp  # exp # stmts
-            HsExpTypeSig  srcloc exp qualtyp ->
-                HsExpTypeSig  # srcloc # exp # qualtyp
-            HsAsPat  name exp		 ->
-                HsAsPat  # name # exp
-            HsWildCard sl 			 ->
-                HsWildCard sl
-            HsIrrPat  exp		 ->
-                HsIrrPat  # exp
-
-instance Renameable HsPat where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsPVar  name ->
-                HsPVar  # name
-            HsPLit  literal ->
-                HsPLit  # literal
-            HsPNeg  pat ->
-                HsPNeg  # pat
-            HsPInfixApp  pat name pat' ->
-                HsPInfixApp  # pat # name # pat'
-            HsPApp  name pats ->
-                HsPApp  # name # pats
-            HsPTuple  pats ->
-                HsPTuple  # pats
-            HsPUnboxedTuple  pats ->
-                HsPUnboxedTuple  # pats
-            HsPList  pats ->
-                HsPList  # pats
-            HsPParen  pat ->
-                HsPParen  # pat
-            HsPRec  name patfields ->
-                HsPRec  # name # patfields
-            HsPAsPat  name pat ->
-                HsPAsPat  # name # pat
-            HsPWildCard  ->
-                HsPWildCard
-            HsPIrrPat  pat ->
-                HsPIrrPat  # pat
-
-
-instance Renameable HsPatField where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-{-
-            HsPFieldPun  name ->
-                HsPFieldPun  # name
--}
-            HsPFieldPat  name pat ->
-                HsPFieldPat  # name # pat
-
-
-instance Renameable (HsStmt) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsGenerator  srcloc pat exp ->
-                HsGenerator  # srcloc # pat # exp
-            HsQualifier  exp ->
-                HsQualifier  # exp
-            HsLetStmt  objects ->
-                HsLetStmt  # objects
-
-
-instance Renameable (HsFieldUpdate) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-{-
-            HsFieldBind  name ->
-                HsFieldBind  # name
--}
-            HsFieldUpdate  name exp ->
-                HsFieldUpdate  # name # exp
-
-instance Renameable HsTyVarBind where
-    replaceName f = hsTyVarBindName_u (replaceName f)
-
-instance Renameable (HsAlt) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsAlt  srcloc pat guardedalts objects ->
-                HsAlt  # srcloc # pat # guardedalts # objects
-
-
-
-instance Renameable HsName where
-    replaceName f name = f name
-
-instance (Renameable a, Renameable b) => Renameable (a,b) where
-    replaceName f (x,y) = (replaceName f x, replaceName f y)
-instance Renameable a => Renameable [a] where
-    replaceName f xs = map (replaceName f) xs
-
-
-type Binding = ()
hunk ./FrontEnd/Rename.hs 1262
+
+
hunk ./FrontEnd/Syn/Traverse.hs 158
+traverseHsType f x@HsTyExpKind { hsTyType = t } = f t >>= \t' -> return x { hsTyType = t' }
hunk ./FrontEnd/TypeSyns.hs 121
-renameHsDecl (HsDataDecl srcLoc hsContext hsName hsNames1 hsConDecls hsNames2) subTable = do
+renameHsDecl dl@HsDataDecl { hsDeclContext = hsContext, hsDeclName = hsName, hsDeclArgs = hsNames1, hsDeclCons = hsConDecls  } subTable = do
hunk ./FrontEnd/TypeSyns.hs 127
-    return (HsDataDecl srcLoc hsContext' hsName' hsNames1' hsConDecls' hsNames2)
+    return dl { hsDeclContext = hsContext', hsDeclName = hsName', hsDeclArgs = hsNames1', hsDeclCons = hsConDecls' }
hunk ./FrontEnd/TypeSyns.hs 574
--- gets the names of the functions declared in a class declaration
-
---------------------------------------------------------------------------------
-
--- the Renameable class
-
-
--- stores the instance Renameable for all of HsSyn
-
-class Renameable a where
-    replaceName :: (HsName -> HsName) -> a -> a
-
-instance Renameable SrcLoc where
-    replaceName f = id
-
-instance Renameable HsExportSpec where
-    replaceName f hsexportspec
-      = let a # b = a $ (replaceName f b)
-        in case hsexportspec of
-            HsEVar  name               ->
-                HsEVar  # name
-            HsEAbs  name               ->
-                HsEAbs  # name
-            HsEThingAll  name		 ->
-                HsEThingAll  # name
-            HsEThingWith  name names	 ->
-                HsEThingWith  # name # names
-            HsEModuleContents mod	 ->
-                HsEModuleContents mod
-
-
-instance Renameable HsImportDecl where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-            a $$ b = a b
-            infixl 0 $$
-        in case object of
-            HsImportDecl  srcloc mod bool maybe1 maybe2 ->
-                HsImportDecl # srcloc $$ mod $$ bool $$ maybe1 $$ maybe2'
-                where maybe2' = fmap (\(b,importSpec) -> (b, replaceName f importSpec)) maybe2
-
-
-instance Renameable HsImportSpec where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsIVar  name			 ->
-                HsIVar  # name
-            HsIAbs  name			 ->
-                HsIAbs  # name
-            HsIThingAll  name		 ->
-                HsIThingAll  # name
-            HsIThingWith  name names	 ->
-                HsIThingWith  # name # names
-
-
-{-
-instance Renameable HsInfixDecl where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsInfixDecl  srcloc fixity names ->
-                HsInfixDecl  # srcloc # fixity # names
--}
-
-
-{-
-instance Renameable HsFixity where
-    replaceName f = id
--}
-
-instance Renameable HsAssoc where
-    replaceName _ object = object
-
-instance Renameable HsTyVarBind where
-    replaceName f = hsTyVarBindName_u (replaceName f)
-
-instance Renameable (HsDecl) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsTypeDecl 	srcloc name names typ ->
-                HsTypeDecl 	srcloc # name # names # typ
-            HsDataDecl 	srcloc context name names condecls names' ->
-                HsDataDecl 	srcloc # context # name # names # condecls # names'
-            HsNewTypeDecl 	srcloc context name names condecl names' ->
-                HsNewTypeDecl 	srcloc # context # name # names # condecl # names'
-            HsClassDecl 	srcloc qualtyp objects ->
-                HsClassDecl 	srcloc # qualtyp # objects
-            HsInstDecl 	srcloc qualtyp objects ->
-                HsInstDecl 	srcloc # qualtyp # objects
-            HsDefaultDecl 	srcloc typ ->
-                HsDefaultDecl 	srcloc # typ
-            HsTypeSig 	srcloc names qualtyp ->
-                HsTypeSig 	srcloc # names # qualtyp
-            -- HsFunBind       srcloc matc ->
-            HsFunBind          matc ->
-                -- HsFunBind  # srcloc # matc
-                HsFunBind  # matc
-            HsPatBind 	srcloc pat r {-where-} objects ->
-                HsPatBind 	srcloc # pat # r # objects
-            od -> od
-
-
-instance Renameable (HsMatch) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsMatch  srcloc name pats r {-where-} objects ->
-                HsMatch  # srcloc # name # pats # r # objects
-
-
-instance Renameable HsConDecl where
-    replaceName f = hsConDeclExists_u (replaceName f) . hsConDeclName_u (replaceName f) . hsConDeclRecArg_u (replaceName f) . hsConDeclConArg_u (replaceName f)
---      let a # b = a $ (replaceName f b)
---        in case object of
---            HsConDecl  srcloc name bangtyps ->
---                HsConDecl  # srcloc # name # bangtyps
---            HsRecDecl  srcloc name names_and_bangtyp ->
---                HsRecDecl  # srcloc # name # names_and_bangtyp
-
-
-
-
-instance Renameable HsBangType where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsBangedTy    typ ->
-                HsBangedTy  # typ
-            HsUnBangedTy  typ ->
-                HsUnBangedTy  # typ
-
-
-instance Renameable (HsRhs) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsUnGuardedRhs  exp ->
-                HsUnGuardedRhs  # exp
-            HsGuardedRhss   guardedrs ->
-                HsGuardedRhss  # guardedrs
-
-
-instance Renameable (HsGuardedRhs) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsGuardedRhs  srcloc exp exp' ->
-                HsGuardedRhs  # srcloc # exp # exp'
-
-
-instance Renameable HsQualType where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsQualType    context typ ->
-                HsQualType  # context # typ
-
-
-instance Renameable HsType where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsTyFun    typ typ' ->
-                HsTyFun  # typ # typ'
-            HsTyTuple  typs ->
-                HsTyTuple  # typs
-            HsTyUnboxedTuple  typs ->
-                HsTyUnboxedTuple  # typs
-            HsTyApp    typ typ' ->
-                HsTyApp  # typ # typ'
-            HsTyVar    name ->
-                HsTyVar  # name
-            HsTyCon    name ->
-                HsTyCon  # name
-
-instance Renameable HsLiteral where
-    replaceName f = id
-
-instance Renameable (HsExp) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            -- HsVar  name ann -> HsVar (replaceName f name) ann
-            HsVar  name -> HsVar (replaceName f name)
-            HsCon  name ->
-                HsCon  # name
-            HsLit  literal ->
-                HsLit  # literal
-            HsInfixApp  exp exp' exp'' ->
-                HsInfixApp  # exp # exp' # exp''
-            HsApp  exp exp' ->
-                HsApp  # exp # exp'
-            HsNegApp  exp ->
-                HsNegApp  # exp
-            HsLambda  srcloc pats exp ->
-                HsLambda  # srcloc # pats # exp
-            HsLet  objects exp ->
-                HsLet  # objects # exp
-            HsIf  exp exp' exp'' ->
-                HsIf  # exp # exp' # exp''
-            HsCase  exp alts ->
-                HsCase  # exp # alts
-            HsDo  stmts ->
-                HsDo  # stmts
-            HsTuple  exps ->
-                HsTuple  # exps
-            HsUnboxedTuple  exps ->
-                HsUnboxedTuple  # exps
-            HsList  exps ->
-                HsList  # exps
-            HsParen  exp ->
-                HsParen  # exp
-            HsLeftSection  exp exp' ->
-                HsLeftSection  # exp # exp'
-            HsRightSection  exp exp' ->
-                HsRightSection  # exp # exp'
-            HsRecConstr  name fieldupdates ->
-                HsRecConstr  # name # fieldupdates
-            HsRecUpdate  exp fieldupdates ->
-                HsRecUpdate  # exp # fieldupdates
-            HsEnumFrom  exp ->
-                HsEnumFrom  # exp
-            HsEnumFromTo  exp exp' ->
-                HsEnumFromTo  # exp # exp'
-            HsEnumFromThen  exp exp' ->
-                HsEnumFromThen  # exp # exp'
-            HsEnumFromThenTo  exp exp' exp'' ->
-                HsEnumFromThenTo  # exp # exp' # exp''
-            HsListComp  exp stmts ->
-                HsListComp  # exp # stmts
-            HsExpTypeSig  srcloc exp qualtyp ->
-                HsExpTypeSig  # srcloc # exp # qualtyp
-            HsAsPat  name exp		 ->
-                HsAsPat  # name # exp
-            HsWildCard x 	      	 ->
-                HsWildCard x
-            HsIrrPat  exp		 ->
-                HsIrrPat  # exp
-
-instance Renameable HsPat where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsPVar  name ->
-                HsPVar  # name
-            HsPLit  literal ->
-                HsPLit  # literal
-            HsPNeg  pat ->
-                HsPNeg  # pat
-            HsPInfixApp  pat name pat' ->
-                HsPInfixApp  # pat # name # pat'
-            HsPApp  name pats ->
-                HsPApp  # name # pats
-            HsPTuple  pats ->
-                HsPTuple  # pats
-            HsPUnboxedTuple  pats ->
-                HsPUnboxedTuple  # pats
-            HsPList  pats ->
-                HsPList  # pats
-            HsPParen  pat ->
-                HsPParen  # pat
-            HsPRec  name patfields ->
-                HsPRec  # name # patfields
-            HsPAsPat  name pat ->
-                HsPAsPat  # name # pat
-            HsPWildCard  ->
-                HsPWildCard
-            HsPIrrPat  pat ->
-                HsPIrrPat  # pat
-
-
-instance Renameable HsPatField where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-{-
-            HsPFieldPun  name ->
-                HsPFieldPun  # name
--}
-            HsPFieldPat  name pat ->
-                HsPFieldPat  # name # pat
-
-
-instance Renameable (HsStmt) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsGenerator  srcloc pat exp ->
-                HsGenerator  # srcloc # pat # exp
-            HsQualifier  exp ->
-                HsQualifier  # exp
-            HsLetStmt  objects ->
-                HsLetStmt  # objects
-
-
-instance Renameable (HsFieldUpdate) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-{-
-            HsFieldBind  name ->
-                HsFieldBind  # name
--}
-            HsFieldUpdate  name exp ->
-                HsFieldUpdate  # name # exp
-
-
-instance Renameable (HsAlt) where
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsAlt  srcloc pat guardedalts objects ->
-                HsAlt  # srcloc # pat # guardedalts # objects
-
-
-
-instance Renameable HsName where
-    replaceName f name = f name
-
-instance Renameable HsAsst where
-    replaceName f (HsAsst x xs) = HsAsst (replaceName f x) (replaceName f xs)
-    replaceName f (HsAsstEq x y) = HsAsstEq (replaceName f x) (replaceName f y)
-
-instance (Renameable a, Renameable b) => Renameable (a,b) where
-    replaceName f (x,y) = (replaceName f x, replaceName f y)
-instance Renameable a => Renameable [a] where
-    replaceName f xs = map (replaceName f) xs
-
-
--- Ident table stuff
---type IdentTable = FiniteMap HsName (SrcLoc, Binding)
---addToIdentTable _ _ = return ()
-
hunk ./FrontEnd/TypeSyns.hs 582
-{-
-printIdentTable :: IdentTable -> IO ()
-printIdentTable idt
-   = putStr $ unlines $ map showIdentTabEntry $ toListFM idt
-   where
-   showIdentTabEntry :: (HsName, (SrcLoc, Binding)) -> String
-   showIdentTabEntry (name, (SrcLoc fn row col, bind))
-      = lJustify 40 (fromHsName name) ++
-        fn ++ ":" ++ showPos (row, col) ++
-        rJustify 10 (show bind)
-   showPos pos@(row, col)
-      | row < 0 || col < 0 = rJustify 10 "none"
-      | otherwise          = rJustify 10 $ show pos
-
--- returns the binding type of a given identifier
-
-bindOfId :: IdentTable -> HsName -> Binding
-bindOfId idtab i
-   = case lookupFM idtab i of
-        Nothing -> error $ "bindOfId: could not find binding for this identifier: " ++ show i
-        Just (_sloc, bind) -> bind
-addToIdentTable :: HsName -> (SrcLoc,Binding) -> ScopeSM ()
-addToIdentTable hsName srcLocAndBinding
-   = modify (\state -> state {identTable = addToFM (identTable state) hsName srcLocAndBinding })
--}
hunk ./FrontEnd/Utils.hs 23
-maybeGetDeclName (HsDataDecl _ _ name  _ _ _) = return (toName TypeConstructor name)
-maybeGetDeclName (HsNewTypeDecl _ _ name  _ _ _) = return (toName TypeConstructor name)
+maybeGetDeclName HsDataDecl { hsDeclName = name } = return (toName TypeConstructor name)
+maybeGetDeclName HsNewTypeDecl { hsDeclName = name } = return (toName TypeConstructor name)