Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-generics
http://hackage.haskell.org/trac/ghc/changeset/ea94a66d93047a9b0cd4532645eb1e9be04888e1 >--------------------------------------------------------------- commit ea94a66d93047a9b0cd4532645eb1e9be04888e1 Merge: ffabe3a... 51fd4a1... Author: Jose Pedro Magalhaes <[email protected]> Date: Thu May 5 08:11:52 2011 +0200 Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics Fixed conflicts: compiler/iface/IfaceSyn.lhs compiler/typecheck/TcSMonad.lhs Makefile | 8 +- aclocal.m4 | 12 - compiler/basicTypes/Var.lhs | 3 +- compiler/deSugar/Check.lhs | 3 +- compiler/iface/IfaceSyn.lhs | 443 ++++++++++++++++++----------------- compiler/llvmGen/LlvmCodeGen/Ppr.hs | 31 +-- compiler/llvmGen/LlvmMangler.hs | 68 ++++-- compiler/main/DriverPhases.hs | 4 - compiler/main/DriverPipeline.hs | 14 +- compiler/main/DynFlags.hs | 9 +- compiler/main/GhcMonad.hs | 4 +- compiler/main/SysTools.lhs | 2 +- compiler/rename/RnExpr.lhs | 21 ++- compiler/typecheck/TcSMonad.lhs | 1 + configure.ac | 2 - ghc.spec.in | 1 - mk/config.mk.in | 2 - utils/Makefile | 2 +- 18 files changed, 319 insertions(+), 311 deletions(-) diff --cc compiler/iface/IfaceSyn.lhs index ea1ace8,950021e..dcf2177 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@@ -54,22 -54,30 +54,22 @@@ infixl 3 && %************************************************************************ \begin{code} - data IfaceDecl - = IfaceId { ifName :: OccName, - ifType :: IfaceType, - ifIdDetails :: IfaceIdDetails, - ifIdInfo :: IfaceIdInfo } - - | IfaceData { ifName :: OccName, -- Type constructor - ifTyVars :: [IfaceTvBndr], -- Type variables - ifCtxt :: IfaceContext, -- The "stupid theta" - ifCons :: IfaceConDecls, -- Includes new/data info - ifRec :: RecFlag, -- Recursive or not? - ifGadtSyntax :: Bool, -- True <=> declared using - -- GADT syntax + data IfaceDecl + = IfaceId { ifName :: OccName, + ifType :: IfaceType, + ifIdDetails :: IfaceIdDetails, + ifIdInfo :: IfaceIdInfo } + + | IfaceData { ifName :: OccName, -- Type constructor + ifTyVars :: [IfaceTvBndr], -- Type variables + ifCtxt :: IfaceContext, -- The "stupid theta" + ifCons :: IfaceConDecls, -- Includes new/data info + ifRec :: RecFlag, -- Recursive or not? + ifGadtSyntax :: Bool, -- True <=> declared using + -- GADT syntax - ifGeneric :: Bool, -- True <=> generic converter - -- functions available - -- We need this for imported - -- data decls, since the - -- imported modules may have - -- been compiled with - -- different flags to the - -- current compilation unit ifFamInst :: Maybe (IfaceTyCon, [IfaceType]) -- Just <=> instance of family - -- Invariant: + -- Invariant: -- ifCons /= IfOpenDataTyCon -- for family instances } @@@ -463,26 -472,26 +464,26 @@@ pprIfaceDecl (IfaceSyn {ifName = tycon = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars) 4 (dcolon <+> ppr kind) -pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context, +pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context, - ifTyVars = tyvars, ifCons = condecls, - ifRec = isrec, ifFamInst = mbFamInst}) + ifTyVars = tyvars, ifCons = condecls, + ifRec = isrec, ifFamInst = mbFamInst}) = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars) - 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls, + 4 (vcat [pprRec isrec, pp_condecls tycon condecls, - pprFamily mbFamInst]) + pprFamily mbFamInst]) where pp_nd = case condecls of - IfAbstractTyCon -> ptext (sLit "data") - IfOpenDataTyCon -> ptext (sLit "data family") - IfDataTyCon _ -> ptext (sLit "data") - IfNewTyCon _ -> ptext (sLit "newtype") - - pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars, - ifFDs = fds, ifATs = ats, ifSigs = sigs, - ifRec = isrec}) + IfAbstractTyCon -> ptext (sLit "data") + IfOpenDataTyCon -> ptext (sLit "data family") + IfDataTyCon _ -> ptext (sLit "data") + IfNewTyCon _ -> ptext (sLit "newtype") + + pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars, + ifFDs = fds, ifATs = ats, ifSigs = sigs, + ifRec = isrec}) = hang (ptext (sLit "class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds) 4 (vcat [pprRec isrec, - sep (map ppr ats), - sep (map ppr sigs)]) + sep (map ppr ats), + sep (map ppr sigs)]) pprRec :: RecFlag -> SDoc pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec diff --cc compiler/typecheck/TcSMonad.lhs index 4573082,63b3bb8..414c63a --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@@ -101,12 -101,13 +101,13 @@@ import FastStrin import HsBinds -- for TcEvBinds stuff import Id -import TcRnTypes -import Data.IORef -#ifdef DEBUG + import StaticFlags( opt_PprStyle_Debug ) +import TcRnTypes +#ifdef DEBUG import Control.Monad( when ) #endif +import Data.IORef \end{code} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
