From: Jose Pedro Magalhaes Date: Thu, 5 May 2011 06:11:52 +0000 (+0200) Subject: Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=ea94a66d93047a9b0cd4532645eb1e9be04888e1;hp=-c Merge branch 'master' of darcs.haskell.org/ghc into ghc-generics Fixed conflicts: compiler/iface/IfaceSyn.lhs compiler/typecheck/TcSMonad.lhs --- ea94a66d93047a9b0cd4532645eb1e9be04888e1 diff --combined compiler/deSugar/Check.lhs index 41d5240,d894179..c5e0118 --- a/compiler/deSugar/Check.lhs +++ b/compiler/deSugar/Check.lhs @@@ -110,8 -110,7 +110,7 @@@ type EqnSet = UniqSet EqnN check :: [EquationInfo] -> ([ExhaustivePat], [EquationInfo]) -- Second result is the shadowed equations -- if there are view patterns, just give up - don't know what the function is - check qs = pprTrace "check" (ppr tidy_qs) $ - (untidy_warns, shadowed_eqns) + check qs = (untidy_warns, shadowed_eqns) where tidy_qs = map tidy_eqn qs (warns, used_nos) = check' ([1..] `zip` tidy_qs) @@@ -645,7 -644,7 +644,7 @@@ might_fail_pat (ConPatOut { pat_args = -- Finally the ones that are sure to succeed, or which are covered by the checking algorithm might_fail_pat (LazyPat _) = False -- Always succeeds -might_fail_pat _ = False -- VarPat, WildPat, LitPat, NPat, TypePat +might_fail_pat _ = False -- VarPat, WildPat, LitPat, NPat -------------- might_fail_lpat :: LPat Id -> Bool diff --combined compiler/iface/IfaceSyn.lhs index ea1ace8,950021e..dcf2177 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@@ -5,34 -5,34 +5,34 @@@ \begin{code} module IfaceSyn ( - module IfaceType, -- Re-export all this + module IfaceType, - IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..), - IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..), - IfaceBinding(..), IfaceConAlt(..), - IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..), - IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, - IfaceInst(..), IfaceFamInst(..), + IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..), + IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..), + IfaceBinding(..), IfaceConAlt(..), + IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..), + IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, + IfaceInst(..), IfaceFamInst(..), - -- Misc + -- Misc ifaceDeclSubBndrs, visibleIfConDecls, -- Free Names freeNamesIfDecl, freeNamesIfRule, - -- Pretty printing - pprIfaceExpr, pprIfaceDeclHead + -- Pretty printing + pprIfaceExpr, pprIfaceDeclHead ) where #include "HsVersions.h" import IfaceType import CoreSyn( DFunArg, dfunArgExprs ) - import PprCore() -- Printing DFunArgs + import PprCore() -- Printing DFunArgs import Demand import Annotations import Class - import NameSet + import NameSet import Name import CostCentre import Literal @@@ -48,66 -48,75 +48,67 @@@ infixl 3 && %************************************************************************ - %* * - Data type declarations - %* * + %* * + Data type declarations + %* * %************************************************************************ \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 } - | IfaceSyn { ifName :: OccName, -- Type constructor - ifTyVars :: [IfaceTvBndr], -- Type variables - ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon) - ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn - -- Nothing for an open family + | IfaceSyn { ifName :: OccName, -- Type constructor + ifTyVars :: [IfaceTvBndr], -- Type variables + ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon) + ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn + -- Nothing for an open family ifFamInst :: Maybe (IfaceTyCon, [IfaceType]) -- Just <=> instance of family -- Invariant: ifOpenSyn == False -- for family instances } - | IfaceClass { ifCtxt :: IfaceContext, -- Context... - ifName :: OccName, -- Name of the class - ifTyVars :: [IfaceTvBndr], -- Type variables - ifFDs :: [FunDep FastString], -- Functional dependencies - ifATs :: [IfaceDecl], -- Associated type families - ifSigs :: [IfaceClassOp], -- Method signatures - ifRec :: RecFlag -- Is newtype/datatype associated with the class recursive? + | IfaceClass { ifCtxt :: IfaceContext, -- Context... + ifName :: OccName, -- Name of the class + ifTyVars :: [IfaceTvBndr], -- Type variables + ifFDs :: [FunDep FastString], -- Functional dependencies + ifATs :: [IfaceDecl], -- Associated type families + ifSigs :: [IfaceClassOp], -- Method signatures + ifRec :: RecFlag -- Is newtype/datatype associated + -- with the class recursive? } | IfaceForeign { ifName :: OccName, -- Needs expanding when we move -- beyond .NET - ifExtName :: Maybe FastString } + ifExtName :: Maybe FastString } data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType - -- Nothing => no default method - -- Just False => ordinary polymorphic default method - -- Just True => generic default method + -- Nothing => no default method + -- Just False => ordinary polymorphic default method + -- Just True => generic default method data IfaceConDecls - = IfAbstractTyCon -- No info - | IfOpenDataTyCon -- Open data family - | IfDataTyCon [IfaceConDecl] -- data type decls - | IfNewTyCon IfaceConDecl -- newtype decls + = IfAbstractTyCon -- No info + | IfOpenDataTyCon -- Open data family + | IfDataTyCon [IfaceConDecl] -- data type decls + | IfNewTyCon IfaceConDecl -- newtype decls visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl] visibleIfConDecls IfAbstractTyCon = [] @@@ -115,49 -124,49 +116,49 @@@ visibleIfConDecls IfOpenDataTyCon = [ visibleIfConDecls (IfDataTyCon cs) = cs visibleIfConDecls (IfNewTyCon c) = [c] - data IfaceConDecl + data IfaceConDecl = IfCon { - ifConOcc :: OccName, -- Constructor name - ifConWrapper :: Bool, -- True <=> has a wrapper - ifConInfix :: Bool, -- True <=> declared infix - ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars - ifConExTvs :: [IfaceTvBndr], -- Existential tyvars - ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints - ifConCtxt :: IfaceContext, -- Non-stupid context - ifConArgTys :: [IfaceType], -- Arg types - ifConFields :: [OccName], -- ...ditto... (field labels) - ifConStricts :: [HsBang]} -- Empty (meaning all lazy), - -- or 1-1 corresp with arg tys - - data IfaceInst - = IfaceInst { ifInstCls :: IfExtName, -- See comments with - ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance - ifDFun :: IfExtName, -- The dfun - ifOFlag :: OverlapFlag, -- Overlap flag - ifInstOrph :: Maybe OccName } -- See Note [Orphans] - -- There's always a separate IfaceDecl for the DFun, which gives - -- its IdInfo with its full type and version number. - -- The instance declarations taken together have a version number, - -- and we don't want that to wobble gratuitously - -- If this instance decl is *used*, we'll record a usage on the dfun; - -- and if the head does not change it won't be used if it wasn't before + ifConOcc :: OccName, -- Constructor name + ifConWrapper :: Bool, -- True <=> has a wrapper + ifConInfix :: Bool, -- True <=> declared infix + ifConUnivTvs :: [IfaceTvBndr], -- Universal tyvars + ifConExTvs :: [IfaceTvBndr], -- Existential tyvars + ifConEqSpec :: [(OccName,IfaceType)], -- Equality contraints + ifConCtxt :: IfaceContext, -- Non-stupid context + ifConArgTys :: [IfaceType], -- Arg types + ifConFields :: [OccName], -- ...ditto... (field labels) + ifConStricts :: [HsBang]} -- Empty (meaning all lazy), + -- or 1-1 corresp with arg tys + + data IfaceInst + = IfaceInst { ifInstCls :: IfExtName, -- See comments with + ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance + ifDFun :: IfExtName, -- The dfun + ifOFlag :: OverlapFlag, -- Overlap flag + ifInstOrph :: Maybe OccName } -- See Note [Orphans] + -- There's always a separate IfaceDecl for the DFun, which gives + -- its IdInfo with its full type and version number. + -- The instance declarations taken together have a version number, + -- and we don't want that to wobble gratuitously + -- If this instance decl is *used*, we'll record a usage on the dfun; + -- and if the head does not change it won't be used if it wasn't before data IfaceFamInst = IfaceFamInst { ifFamInstFam :: IfExtName -- Family tycon - , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types - , ifFamInstTyCon :: IfaceTyCon -- Instance decl - } + , ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types + , ifFamInstTyCon :: IfaceTyCon -- Instance decl + } data IfaceRule - = IfaceRule { - ifRuleName :: RuleName, - ifActivation :: Activation, - ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars - ifRuleHead :: IfExtName, -- Head of lhs - ifRuleArgs :: [IfaceExpr], -- Args of LHS - ifRuleRhs :: IfaceExpr, - ifRuleAuto :: Bool, - ifRuleOrph :: Maybe OccName -- Just like IfaceInst + = IfaceRule { + ifRuleName :: RuleName, + ifActivation :: Activation, + ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars + ifRuleHead :: IfExtName, -- Head of lhs + ifRuleArgs :: [IfaceExpr], -- Args of LHS + ifRuleRhs :: IfaceExpr, + ifRuleAuto :: Bool, + ifRuleOrph :: Maybe OccName -- Just like IfaceInst } data IfaceAnnotation @@@ -179,80 -188,80 +180,80 @@@ data IfaceIdDetail | IfDFunId Int -- Number of silent args data IfaceIdInfo - = NoInfo -- When writing interface file without -O - | HasInfo [IfaceInfoItem] -- Has info, and here it is + = NoInfo -- When writing interface file without -O + | HasInfo [IfaceInfoItem] -- Has info, and here it is -- Here's a tricky case: -- * Compile with -O module A, and B which imports A.f -- * Change function f in A, and recompile without -O -- * When we read in old A.hi we read in its IdInfo (as a thunk) - -- (In earlier GHCs we used to drop IdInfo immediately on reading, - -- but we do not do that now. Instead it's discarded when the - -- ModIface is read into the various decl pools.) + -- (In earlier GHCs we used to drop IdInfo immediately on reading, + -- but we do not do that now. Instead it's discarded when the + -- ModIface is read into the various decl pools.) -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *) - -- and so gives a new version. + -- and so gives a new version. data IfaceInfoItem - = HsArity Arity + = HsArity Arity | HsStrictness StrictSig | HsInline InlinePragma - | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true - IfaceUnfolding -- See Note [Expose recursive functions] + | HsUnfold Bool -- True <=> isNonRuleLoopBreaker is true + IfaceUnfolding -- See Note [Expose recursive functions] | HsNoCafRefs -- NB: Specialisations and rules come in separately and are -- only later attached to the Id. Partial reason: some are orphans. - data IfaceUnfolding + data IfaceUnfolding = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding -- Possibly could eliminate the Bool here, the information -- is also in the InlinePragma. - | IfCompulsory IfaceExpr -- Only used for default methods, in fact + | IfCompulsory IfaceExpr -- Only used for default methods, in fact | IfInlineRule Arity -- INLINE pragmas - Bool -- OK to inline even if *un*-saturated - Bool -- OK to inline even if context is boring - IfaceExpr + Bool -- OK to inline even if *un*-saturated + Bool -- OK to inline even if context is boring + IfaceExpr - | IfExtWrapper Arity IfExtName -- NB: sometimes we need a IfExtName (not just IfLclName) - | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in - -- another module. + | IfExtWrapper Arity IfExtName -- NB: sometimes we need a IfExtName (not just IfLclName) + | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in + -- another module. | IfDFunUnfold [DFunArg IfaceExpr] -------------------------------- data IfaceExpr - = IfaceLcl IfLclName + = IfaceLcl IfLclName | IfaceExt IfExtName | IfaceType IfaceType - | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted - | IfaceLam IfaceBndr IfaceExpr - | IfaceApp IfaceExpr IfaceExpr - | IfaceCase IfaceExpr IfLclName IfaceType [IfaceAlt] - | IfaceLet IfaceBinding IfaceExpr - | IfaceNote IfaceNote IfaceExpr + | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted + | IfaceLam IfaceBndr IfaceExpr + | IfaceApp IfaceExpr IfaceExpr + | IfaceCase IfaceExpr IfLclName IfaceType [IfaceAlt] + | IfaceLet IfaceBinding IfaceExpr + | IfaceNote IfaceNote IfaceExpr | IfaceCast IfaceExpr IfaceCoercion - | IfaceLit Literal - | IfaceFCall ForeignCall IfaceType + | IfaceLit Literal + | IfaceFCall ForeignCall IfaceType | IfaceTick Module Int data IfaceNote = IfaceSCC CostCentre | IfaceCoreNote String type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr) - -- Note: IfLclName, not IfaceBndr (and same with the case binder) - -- We reconstruct the kind/type of the thing from the context - -- thus saving bulk in interface files + -- Note: IfLclName, not IfaceBndr (and same with the case binder) + -- We reconstruct the kind/type of the thing from the context + -- thus saving bulk in interface files data IfaceConAlt = IfaceDefault - | IfaceDataAlt IfExtName - | IfaceTupleAlt Boxity - | IfaceLitAlt Literal + | IfaceDataAlt IfExtName + | IfaceTupleAlt Boxity + | IfaceLitAlt Literal data IfaceBinding - = IfaceNonRec IfaceLetBndr IfaceExpr - | IfaceRec [(IfaceLetBndr, IfaceExpr)] + = IfaceNonRec IfaceLetBndr IfaceExpr + | IfaceRec [(IfaceLetBndr, IfaceExpr)] -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too -- It's used for *non-top-level* let/rec binders @@@ -291,9 -300,9 +292,9 @@@ complicate the situation though. Consid and suppose we are compiling module X: module X where - import M - data T = ... - instance C Int T where ... + import M + data T = ... + instance C Int T where ... This instance is an orphan, because when compiling a third module Y we might get a constraint (C Int v), and we'd want to improve v to T. So @@@ -307,7 -316,7 +308,7 @@@ More precisely, an instance is an orpha If there are fundeps, then for every fundep, at least one of the names free in a *non-determined* part of the instance head is - defined in this module. + defined in this module. (Note that these conditions hold trivially if the class is locally defined.) @@@ -334,10 -343,10 +335,10 @@@ a functionally-dependent part of the in and suppose we are compiling module X: module X where - import M - data S = ... - data T = ... - instance C S T where ... + import M + data S = ... + data T = ... + instance C S T where ... If we base the instance verion on T, I'm worried that changing S to S' would change T's version, but not S or S'. But an importing module might @@@ -348,8 -357,8 +349,8 @@@ and it seems deeply obscure, so I'm goi Note [Versioning of rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~ - A rule that is not an orphan has an ifRuleOrph field of (Just n), where - n appears on the LHS of the rule; any change in the rule changes the version of n. + A rule that is not an orphan has an ifRuleOrph field of (Just n), where n + appears on the LHS of the rule; any change in the rule changes the version of n. \begin{code} @@@ -372,7 -381,7 +373,7 @@@ ifaceDeclSubBndrs IfaceData {ifCons = I ifaceDeclSubBndrs (IfaceData {ifName = tc_occ, ifCons = IfNewTyCon ( IfCon { ifConOcc = con_occ }), - ifFamInst = famInst}) + ifFamInst = famInst}) = -- implicit coerion and (possibly) family instance coercion (mkNewTyCoOcc tc_occ) : (famInstCo famInst tc_occ) ++ -- data constructor and worker (newtypes don't have a wrapper) @@@ -380,8 -389,8 +381,8 @@@ ifaceDeclSubBndrs (IfaceData {ifName = tc_occ, - ifCons = IfDataTyCon cons, - ifFamInst = famInst}) + ifCons = IfDataTyCon cons, + ifFamInst = famInst}) = -- (possibly) family instance coercion; -- there is no implicit coercion for non-newtypes famInstCo famInst tc_occ @@@ -390,20 -399,20 +391,20 @@@ ++ concatMap dc_occs cons where dc_occs con_decl - | has_wrapper = [con_occ, work_occ, wrap_occ] - | otherwise = [con_occ, work_occ] - where - con_occ = ifConOcc con_decl -- DataCon namespace - wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace - work_occ = mkDataConWorkerOcc con_occ -- Id namespace - has_wrapper = ifConWrapper con_decl -- This is the reason for - -- having the ifConWrapper field! - - ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, - ifSigs = sigs, ifATs = ats }) + | has_wrapper = [con_occ, work_occ, wrap_occ] + | otherwise = [con_occ, work_occ] + where + con_occ = ifConOcc con_decl -- DataCon namespace + wrap_occ = mkDataConWrapperOcc con_occ -- Id namespace + work_occ = mkDataConWorkerOcc con_occ -- Id namespace + has_wrapper = ifConWrapper con_decl -- This is the reason for + -- having the ifConWrapper field! + + ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, + ifSigs = sigs, ifATs = ats }) = -- dictionary datatype: -- type constructor - tc_occ : + tc_occ : -- (possibly) newtype coercion co_occs ++ -- data constructor (DataCon namespace) @@@ -420,14 -429,14 +421,14 @@@ n_ctxt = length sc_ctxt n_sigs = length sigs tc_occ = mkClassTyConOcc cls_occ - dc_occ = mkClassDataConOcc cls_occ + dc_occ = mkClassDataConOcc cls_occ co_occs | is_newtype = [mkNewTyCoOcc tc_occ] - | otherwise = [] + | otherwise = [] dcww_occ = mkDataConWorkerOcc dc_occ - is_newtype = n_sigs + n_ctxt == 1 -- Sigh + is_newtype = n_sigs + n_ctxt == 1 -- Sigh ifaceDeclSubBndrs (IfaceSyn {ifName = tc_occ, - ifFamInst = famInst}) + ifFamInst = famInst}) = famInstCo famInst tc_occ ifaceDeclSubBndrs _ = [] @@@ -443,50 -452,54 +444,50 @@@ instance Outputable IfaceDecl wher ppr = pprIfaceDecl pprIfaceDecl :: IfaceDecl -> SDoc - pprIfaceDecl (IfaceId {ifName = var, ifType = ty, + pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdDetails = details, ifIdInfo = info}) - = sep [ ppr var <+> dcolon <+> ppr ty, - nest 2 (ppr details), - nest 2 (ppr info) ] + = sep [ ppr var <+> dcolon <+> ppr ty, + nest 2 (ppr details), + nest 2 (ppr info) ] pprIfaceDecl (IfaceForeign {ifName = tycon}) = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon] - pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, - ifSynRhs = Just mono_ty, + pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, + ifSynRhs = Just mono_ty, ifFamInst = mbFamInst}) = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars) 4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst]) - pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, - ifSynRhs = Nothing, ifSynKind = kind }) + pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, + ifSynRhs = Nothing, ifSynKind = kind }) = 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 -pprGen :: Bool -> SDoc -pprGen True = ptext (sLit "Generics: yes") -pprGen False = ptext (sLit "Generics: no") - pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc pprFamily Nothing = ptext (sLit "FamilyInstance: none") pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst @@@ -496,68 -509,68 +497,68 @@@ instance Outputable IfaceClassOp wher pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc pprIfaceDeclHead context thing tyvars - = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing), - pprIfaceTvBndrs tyvars] + = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing), + pprIfaceTvBndrs tyvars] pp_condecls :: OccName -> IfaceConDecls -> SDoc pp_condecls _ IfAbstractTyCon = ptext (sLit "{- abstract -}") pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c pp_condecls _ IfOpenDataTyCon = empty pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext (sLit " |")) - (map (pprIfaceConDecl tc) cs)) + (map (pprIfaceConDecl tc) cs)) pprIfaceConDecl :: OccName -> IfaceConDecl -> SDoc pprIfaceConDecl tc - (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap, - ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs, - ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys, - ifConStricts = strs, ifConFields = fields }) + (IfCon { ifConOcc = name, ifConInfix = is_infix, ifConWrapper = has_wrap, + ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs, + ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys, + ifConStricts = strs, ifConFields = fields }) = sep [main_payload, - if is_infix then ptext (sLit "Infix") else empty, - if has_wrap then ptext (sLit "HasWrapper") else empty, - ppUnless (null strs) $ - nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)), - ppUnless (null fields) $ - nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))] + if is_infix then ptext (sLit "Infix") else empty, + if has_wrap then ptext (sLit "HasWrapper") else empty, + ppUnless (null strs) $ + nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)), + ppUnless (null fields) $ + nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))] where - ppr_bang HsNoBang = char '_' -- Want to see these + ppr_bang HsNoBang = char '_' -- Want to see these ppr_bang bang = ppr bang - - main_payload = ppr name <+> dcolon <+> - pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau - eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty) - | (tv,ty) <- eq_spec] + main_payload = ppr name <+> dcolon <+> + pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau - -- A bit gruesome this, but we can't form the full con_tau, and ppr it, - -- because we don't have a Name for the tycon, only an OccName + eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty) + | (tv,ty) <- eq_spec] + + -- A bit gruesome this, but we can't form the full con_tau, and ppr it, + -- because we don't have a Name for the tycon, only an OccName pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of - (t:ts) -> fsep (t : map (arrow <+>) ts) - [] -> panic "pp_con_taus" + (t:ts) -> fsep (t : map (arrow <+>) ts) + [] -> panic "pp_con_taus" pp_res_ty = ppr tc <+> fsep [ppr tv | (tv,_) <- univ_tvs] instance Outputable IfaceRule where ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs, - ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs }) + ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs }) = sep [hsep [doubleQuotes (ftext name), ppr act, - ptext (sLit "forall") <+> pprIfaceBndrs bndrs], - nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args), - ptext (sLit "=") <+> ppr rhs]) + ptext (sLit "forall") <+> pprIfaceBndrs bndrs], + nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args), + ptext (sLit "=") <+> ppr rhs]) ] instance Outputable IfaceInst where - ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag, - ifInstCls = cls, ifInstTys = mb_tcs}) - = hang (ptext (sLit "instance") <+> ppr flag - <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs)) + ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag, + ifInstCls = cls, ifInstTys = mb_tcs}) + = hang (ptext (sLit "instance") <+> ppr flag + <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs)) 2 (equals <+> ppr dfun_id) instance Outputable IfaceFamInst where ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs, - ifFamInstTyCon = tycon_id}) - = hang (ptext (sLit "family instance") <+> - ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs)) + ifFamInstTyCon = tycon_id}) + = hang (ptext (sLit "family instance") <+> + ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs)) 2 (equals <+> ppr tycon_id) ppr_rough :: Maybe IfaceTyCon -> SDoc @@@ -575,9 -588,11 +576,11 @@@ instance Outputable IfaceExpr wher pprParendIfaceExpr :: IfaceExpr -> SDoc pprParendIfaceExpr = pprIfaceExpr parens + -- | Pretty Print an IfaceExpre + -- + -- The first argument should be a function that adds parens in context that need + -- an atomic value (e.g. function args) pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc - -- The function adds parens in context that need - -- an atomic value (e.g. function args) pprIfaceExpr _ (IfaceLcl v) = ppr v pprIfaceExpr _ (IfaceExt v) = ppr v @@@ -589,100 -604,107 +592,107 @@@ pprIfaceExpr _ (IfaceType ty pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app []) pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as) - pprIfaceExpr add_par e@(IfaceLam _ _) + pprIfaceExpr add_par i@(IfaceLam _ _) = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow, - pprIfaceExpr noParens body]) - where - (bndrs,body) = collect [] e + pprIfaceExpr noParens body]) + where + (bndrs,body) = collect [] i collect bs (IfaceLam b e) = collect (b:bs) e collect bs e = (reverse bs, e) pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)]) = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty - <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") - <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow, - pprIfaceExpr noParens rhs <+> char '}']) + <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") + <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow, + pprIfaceExpr noParens rhs <+> char '}']) pprIfaceExpr add_par (IfaceCase scrut bndr ty alts) = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty - <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") - <+> ppr bndr <+> char '{', - nest 2 (sep (map ppr_alt alts)) <+> char '}']) + <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of") + <+> ppr bndr <+> char '{', + nest 2 (sep (map ppr_alt alts)) <+> char '}']) pprIfaceExpr _ (IfaceCast expr co) = sep [pprParendIfaceExpr expr, - nest 2 (ptext (sLit "`cast`")), - pprParendIfaceType co] + nest 2 (ptext (sLit "`cast`")), + pprParendIfaceType co] pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body) - = add_par (sep [ptext (sLit "let {"), - nest 2 (ppr_bind (b, rhs)), - ptext (sLit "} in"), - pprIfaceExpr noParens body]) + = add_par (sep [ptext (sLit "let {"), + nest 2 (ppr_bind (b, rhs)), + ptext (sLit "} in"), + pprIfaceExpr noParens body]) pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body) = add_par (sep [ptext (sLit "letrec {"), - nest 2 (sep (map ppr_bind pairs)), - ptext (sLit "} in"), - pprIfaceExpr noParens body]) + nest 2 (sep (map ppr_bind pairs)), + ptext (sLit "} in"), + pprIfaceExpr noParens body]) - pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body) + pprIfaceExpr add_par (IfaceNote note body) = add_par $ ppr note + <+> pprParendIfaceExpr body ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc - ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs, - arrow <+> pprIfaceExpr noParens rhs] + ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs, + arrow <+> pprIfaceExpr noParens rhs] ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs) - ppr_con_bs con bs = ppr con <+> hsep (map ppr bs) - + ppr_con_bs con bs = ppr con <+> hsep (map ppr bs) + ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc - ppr_bind (IfLetBndr b ty info, rhs) + ppr_bind (IfLetBndr b ty info, rhs) = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info), - equals <+> pprIfaceExpr noParens rhs] + equals <+> pprIfaceExpr noParens rhs] ------------------ pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc - pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprParendIfaceExpr arg) : args) - pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args) + pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun $ + nest 2 (pprParendIfaceExpr arg) : args + pprIfaceApp fun args = sep (pprParendIfaceExpr fun : args) ------------------ instance Outputable IfaceNote where ppr (IfaceSCC cc) = pprCostCentreCore cc - ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s) + ppr (IfaceCoreNote s) = ptext (sLit "__core_note") + <+> pprHsString (mkFastString s) instance Outputable IfaceConAlt where ppr IfaceDefault = text "DEFAULT" ppr (IfaceLitAlt l) = ppr l ppr (IfaceDataAlt d) = ppr d - ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt" + ppr (IfaceTupleAlt _) = panic "ppr IfaceConAlt" -- IfaceTupleAlt is handled by the case-alternative printer ------------------ instance Outputable IfaceIdDetails where - ppr IfVanillaId = empty + ppr IfVanillaId = empty ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc - <+> if b then ptext (sLit "") else empty + <+> if b then ptext (sLit "") else empty ppr (IfDFunId ns) = ptext (sLit "DFunId") <> brackets (int ns) instance Outputable IfaceIdInfo where ppr NoInfo = empty - ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}") + ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is + <+> ptext (sLit "-}") instance Outputable IfaceInfoItem where - ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") <> ppWhen lb (ptext (sLit "(loop-breaker)")) + ppr (HsUnfold lb unf) = ptext (sLit "Unfolding") + <> ppWhen lb (ptext (sLit "(loop-breaker)")) <> colon <+> ppr unf ppr (HsInline prag) = ptext (sLit "Inline:") <+> ppr prag ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str - ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs") + ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs") instance Outputable IfaceUnfolding where ppr (IfCompulsory e) = ptext (sLit "") <+> parens (ppr e) - ppr (IfCoreUnfold s e) = (if s then ptext (sLit "") else empty) <+> parens (ppr e) - ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok), - pprParendIfaceExpr e] + ppr (IfCoreUnfold s e) = (if s then ptext (sLit "") else empty) + <+> parens (ppr e) + ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") + <+> ppr (a,uok,bok), + pprParendIfaceExpr e] ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a) ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr @@@ -691,7 -713,7 +701,7 @@@ <+> brackets (pprWithCommas ppr ns) -- ----------------------------------------------------------------------------- - -- Finding the Names in IfaceSyn + -- | Finding the Names in IfaceSyn -- This is used for dependency analysis in MkIface, so that we -- fingerprint a declaration before the things that depend on it. It @@@ -701,11 -723,11 +711,11 @@@ -- fingerprinting the instance, so DFuns are not dependencies. freeNamesIfDecl :: IfaceDecl -> NameSet - freeNamesIfDecl (IfaceId _s t d i) = + freeNamesIfDecl (IfaceId _s t d i) = freeNamesIfType t &&& freeNamesIfIdInfo i &&& freeNamesIfIdDetails d - freeNamesIfDecl IfaceForeign{} = + freeNamesIfDecl IfaceForeign{} = emptyNameSet freeNamesIfDecl d@IfaceData{} = freeNamesIfTvBndrs (ifTyVars d) &&& @@@ -732,7 -754,7 +742,7 @@@ freeNamesIfSynRhs (Just ty) = freeNames freeNamesIfSynRhs Nothing = emptyNameSet freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet - freeNamesIfTcFam (Just (tc,tys)) = + freeNamesIfTcFam (Just (tc,tys)) = freeNamesIfTc tc &&& fnList freeNamesIfType tys freeNamesIfTcFam Nothing = emptyNameSet @@@ -752,15 -774,15 +762,15 @@@ freeNamesIfConDecls (IfNewTyCon c) = f freeNamesIfConDecls _ = emptyNameSet freeNamesIfConDecl :: IfaceConDecl -> NameSet - freeNamesIfConDecl c = + freeNamesIfConDecl c = freeNamesIfTvBndrs (ifConUnivTvs c) &&& freeNamesIfTvBndrs (ifConExTvs c) &&& - freeNamesIfContext (ifConCtxt c) &&& + freeNamesIfContext (ifConCtxt c) &&& fnList freeNamesIfType (ifConArgTys c) &&& fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints freeNamesIfPredType :: IfacePredType -> NameSet - freeNamesIfPredType (IfaceClassP cl tys) = + freeNamesIfPredType (IfaceClassP cl tys) = unitNameSet cl &&& fnList freeNamesIfType tys freeNamesIfPredType (IfaceIParam _n ty) = freeNamesIfType ty @@@ -771,7 -793,7 +781,7 @@@ freeNamesIfType :: IfaceType -> NameSe freeNamesIfType (IfaceTyVar _) = emptyNameSet freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t freeNamesIfType (IfacePredTy st) = freeNamesIfPredType st - freeNamesIfType (IfaceTyConApp tc ts) = + freeNamesIfType (IfaceTyConApp tc ts) = freeNamesIfTc tc &&& fnList freeNamesIfType ts freeNamesIfType (IfaceForAllTy tv t) = freeNamesIfTvBndr tv &&& freeNamesIfType t @@@ -786,7 -808,7 +796,7 @@@ freeNamesIfBndr (IfaceTvBndr b) = freeN freeNamesIfLetBndr :: IfaceLetBndr -> NameSet -- Remember IfaceLetBndr is used only for *nested* bindings - -- The IdInfo can contain an unfolding (in the case of + -- The IdInfo can contain an unfolding (in the case of -- local INLINE pragmas), so look there too freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty &&& freeNamesIfIdInfo info @@@ -799,7 -821,7 +809,7 @@@ freeNamesIfIdBndr :: IfaceIdBndr -> Nam freeNamesIfIdBndr = freeNamesIfTvBndr freeNamesIfIdInfo :: IfaceIdInfo -> NameSet - freeNamesIfIdInfo NoInfo = emptyNameSet + freeNamesIfIdInfo NoInfo = emptyNameSet freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i freeNamesItem :: IfaceInfoItem -> NameSet @@@ -815,17 -837,17 +825,17 @@@ freeNamesIfUnfold (IfLclWrapper {} freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs) freeNamesIfExpr :: IfaceExpr -> NameSet - freeNamesIfExpr (IfaceExt v) = unitNameSet v + freeNamesIfExpr (IfaceExt v) = unitNameSet v freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co - freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r + freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r freeNamesIfExpr (IfaceCase s _ ty alts) - = freeNamesIfExpr s + = freeNamesIfExpr s &&& fnList fn_alt alts &&& fn_cons alts &&& freeNamesIfType ty where @@@ -833,10 -855,10 +843,10 @@@ -- Depend on the data constructors. Just one will do! -- Note [Tracking data constructors] - fn_cons [] = emptyNameSet - fn_cons ((IfaceDefault ,_,_) : alts) = fn_cons alts - fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con - fn_cons (_ : _ ) = emptyNameSet + fn_cons [] = emptyNameSet + fn_cons ((IfaceDefault ,_,_) : xs) = fn_cons xs + fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con + fn_cons (_ : _ ) = emptyNameSet freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body) = freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body @@@ -871,18 -893,18 +881,18 @@@ fnList f = foldr (&&&) emptyNameSet . m Note [Tracking data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - In a case expression + In a case expression case e of { C a -> ...; ... } You might think that we don't need to include the datacon C - in the free names, because its type will probably show up in + in the free names, because its type will probably show up in the free names of 'e'. But in rare circumstances this may not happen. Here's the one that bit me: - module DynFlags where + module DynFlags where import {-# SOURCE #-} Packages( PackageState ) data DynFlags = DF ... PackageState ... - module Packages where + module Packages where import DynFlags data PackageState = PS ... lookupModule (df :: DynFlags) @@@ -893,3 -915,4 +903,4 @@@ Now, lookupModule depends on DynFlags, but the transitive dependency on the *locally-defined* type PackageState is not visible. We need to take account of the use of the data constructor PS in the pattern match. + diff --combined compiler/main/DynFlags.hs index 3a10e02,4131a34..3960717 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@@ -321,6 -321,7 +321,6 @@@ data ExtensionFla | Opt_TemplateHaskell | Opt_QuasiQuotes | Opt_ImplicitParams - | Opt_Generics -- "Derivable type classes" | Opt_ImplicitPrelude | Opt_ScopedTypeVariables | Opt_UnboxedTuples @@@ -342,9 -343,6 +342,9 @@@ | Opt_DeriveFunctor | Opt_DeriveTraversable | Opt_DeriveFoldable + | Opt_DeriveRepresentable -- Allow deriving Representable0/1 + | Opt_DefaultSignatures -- Allow extra signatures for defmeths + | Opt_Generics -- Generic deriving mechanism | Opt_TypeSynonymInstances | Opt_FlexibleContexts @@@ -1105,12 -1103,13 +1105,13 @@@ parseDynamicFlags_ dflags0 args pkg_fla when (not (null errs)) $ ghcError $ errorsToGhcException errs let (pic_warns, dflags2) - | not (cTargetArch == X86_64 && cTargetOS == Linux) && + | not (cTargetArch == X86_64 && (cTargetOS == Linux || cTargetOS == OSX)) && (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm - = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -" - ++ "dynamic on this platform;\n" - ++ " using " ++ showHscTargetFlag defaultObjectTarget ++ " instead"], + = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and " + ++ "-dynamic on this platform;\n" + ++ " using " + ++ showHscTargetFlag defaultObjectTarget ++ " instead"], dflags1{ hscTarget = defaultObjectTarget }) | otherwise = ([], dflags1) @@@ -1681,8 -1680,6 +1682,8 @@@ xFlags = ( "DeriveFunctor", Opt_DeriveFunctor, nop ), ( "DeriveTraversable", Opt_DeriveTraversable, nop ), ( "DeriveFoldable", Opt_DeriveFoldable, nop ), + ( "DeriveRepresentable", Opt_DeriveRepresentable, nop ), + ( "DefaultSignatures", Opt_DefaultSignatures, nop ), ( "TypeSynonymInstances", Opt_TypeSynonymInstances, nop ), ( "FlexibleContexts", Opt_FlexibleContexts, nop ), ( "FlexibleInstances", Opt_FlexibleInstances, nop ), @@@ -1748,9 -1745,6 +1749,9 @@@ impliedFlag , (Opt_RecordWildCards, turnOn, Opt_DisambiguateRecordFields) , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp) + -- The new behavior of the XGenerics flag is just to turn on these two flags + , (Opt_Generics, turnOn, Opt_DefaultSignatures) + , (Opt_Generics, turnOn, Opt_DeriveRepresentable) ] optLevelFlags :: [([Int], DynFlag)] @@@ -1866,7 -1860,6 +1867,7 @@@ glasgowExtsFlags = , Opt_DeriveFunctor , Opt_DeriveFoldable , Opt_DeriveTraversable + , Opt_DeriveRepresentable , Opt_FlexibleContexts , Opt_FlexibleInstances , Opt_ConstrainedClassMethods diff --combined 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}