Commit 7d3f2dfc authored by Alan Zimmerman's avatar Alan Zimmerman Committed by Austin Seipp
Browse files

PostTcType replaced with TypeAnnot

Summary:
This is a first step toward allowing generic traversals of the AST without 'landmines', by removing the `panic`s located throughout `placeHolderType`, `placeHolderKind` & co.

See more on the discussion at https://www.mail-archive.com/ghc-devs@haskell.org/msg05564.html

(This also makes a corresponding update to the `haddock` submodule.)

Test Plan: `sh validate` and new tests pass.

Reviewers: austin, simonpj, goldfire

Reviewed By: austin, simonpj, goldfire

Subscribers: edsko, Fuuzetsu, thomasw, holzensp, goldfire, simonmar, relrod, ezyang, carter

Projects: #ghc

Differential Revision: https://phabricator.haskell.org/D157
parent 7bf7ca2b
......@@ -220,7 +220,7 @@ check' ((n, EqnInfo { eqn_pats = ps, eqn_rhs = MatchResult can_fail _ }) : rs)
= ([], unitUniqSet n) -- One eqn, which can't fail
| first_eqn_all_vars && null rs -- One eqn, but it can fail
= ([(takeList ps (repeat nlWildPat),[])], unitUniqSet n)
= ([(takeList ps (repeat nlWildPatName),[])], unitUniqSet n)
| first_eqn_all_vars -- Several eqns, first can fail
= (pats, addOneToUniqSet indexs n)
......@@ -281,7 +281,8 @@ process_literals used_lits qs
default_eqns = ASSERT2( okGroup qs, pprGroup qs )
[remove_var q | q <- qs, is_var (firstPatN q)]
(pats',indexs') = check' default_eqns
pats_default = [(nlWildPat:ps,constraints) | (ps,constraints) <- (pats')] ++ pats
pats_default = [(nlWildPatName:ps,constraints) |
(ps,constraints) <- (pats')] ++ pats
indexs_default = unionUniqSets indexs' indexs
\end{code}
......@@ -326,7 +327,8 @@ nothing to do.
\begin{code}
first_column_only_vars :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
first_column_only_vars qs = (map (\ (xs,ys) -> (nlWildPat:xs,ys)) pats,indexs)
first_column_only_vars qs
= (map (\ (xs,ys) -> (nlWildPatName:xs,ys)) pats,indexs)
where
(pats, indexs) = check' (map remove_var qs)
\end{code}
......@@ -400,7 +402,8 @@ remove_first_column _ _ = panic "Check.remove_first_column: Not ConPatOut"
make_row_vars :: [HsLit] -> (EqnNo, EquationInfo) -> ExhaustivePat
make_row_vars used_lits (_, EqnInfo { eqn_pats = pats})
= (nlVarPat new_var:takeList (tail pats) (repeat nlWildPat),[(new_var,used_lits)])
= (nlVarPat new_var:takeList (tail pats) (repeat nlWildPatName)
,[(new_var,used_lits)])
where
new_var = hash_x
......@@ -411,7 +414,7 @@ hash_x = mkInternalName unboundKey {- doesn't matter much -}
make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat]
make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats})
= takeList (tail pats) (repeat nlWildPat)
= takeList (tail pats) (repeat nlWildPatName)
compare_cons :: Pat Id -> Pat Id -> Bool
compare_cons (ConPatOut{ pat_con = L _ con1 }) (ConPatOut{ pat_con = L _ con2 })
......@@ -594,10 +597,14 @@ make_con (ConPatOut{ pat_con = L _ (RealDataCon id) }) (lp:lq:ps, constraints)
| isInfixCon id = (nlInfixConPat (getName id) lp lq : ps, constraints)
where q = unLoc lq
make_con (ConPatOut{ pat_con = L _ (RealDataCon id), pat_args = PrefixCon pats, pat_arg_tys = tys }) (ps, constraints)
| isTupleTyCon tc = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) tys) : rest_pats, constraints)
| isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType) : rest_pats, constraints)
| otherwise = (nlConPat name pats_con : rest_pats, constraints)
make_con (ConPatOut{ pat_con = L _ (RealDataCon id), pat_args = PrefixCon pats})
(ps, constraints)
| isTupleTyCon tc = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) [])
: rest_pats, constraints)
| isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType)
: rest_pats, constraints)
| otherwise = (nlConPatName name pats_con
: rest_pats, constraints)
where
name = getName id
(pats_con, rest_pats) = splitAtList pats ps
......@@ -612,11 +619,12 @@ make_con _ _ = panic "Check.make_con: Not ConPatOut"
-- representation
make_whole_con :: DataCon -> WarningPat
make_whole_con con | isInfixCon con = nlInfixConPat name nlWildPat nlWildPat
| otherwise = nlConPat name pats
make_whole_con con | isInfixCon con = nlInfixConPat name
nlWildPatName nlWildPatName
| otherwise = nlConPatName name pats
where
name = getName con
pats = [nlWildPat | _ <- dataConOrigArgTys con]
pats = [nlWildPatName | _ <- dataConOrigArgTys con]
\end{code}
------------------------------------------------------------------------
......@@ -745,7 +753,7 @@ tidy_con :: ConLike -> HsConPatDetails Id -> HsConPatDetails Id
tidy_con _ (PrefixCon ps) = PrefixCon (map tidy_lpat ps)
tidy_con _ (InfixCon p1 p2) = PrefixCon [tidy_lpat p1, tidy_lpat p2]
tidy_con con (RecCon (HsRecFields fs _))
| null fs = PrefixCon (replicate arity nlWildPat)
| null fs = PrefixCon (replicate arity nlWildPatId)
-- Special case for null patterns; maybe not a record at all
| otherwise = PrefixCon (map (tidy_lpat.snd) all_pats)
where
......@@ -755,7 +763,7 @@ tidy_con con (RecCon (HsRecFields fs _))
-- pad out all the missing fields with WildPats.
field_pats = case con of
RealDataCon dc -> map (\ f -> (f, nlWildPat)) (dataConFieldLabels dc)
RealDataCon dc -> map (\ f -> (f, nlWildPatId)) (dataConFieldLabels dc)
PatSynCon{} -> panic "Check.tidy_con: pattern synonym with record syntax"
all_pats = foldr (\(HsRecField id p _) acc -> insertNm (getName (unLoc id)) p acc)
field_pats fs
......
......@@ -676,7 +676,8 @@ makes all list literals be generated via the simple route.
\begin{code}
dsExplicitList :: PostTcType -> Maybe (SyntaxExpr Id) -> [LHsExpr Id] -> DsM CoreExpr
dsExplicitList :: PostTc Id Type -> Maybe (SyntaxExpr Id) -> [LHsExpr Id]
-> DsM CoreExpr
-- See Note [Desugaring explicit lists]
dsExplicitList elt_ty Nothing xs
= do { dflags <- getDynFlags
......
......@@ -280,6 +280,7 @@ Library
HsExpr
HsImpExp
HsLit
PlaceHolder
HsPat
HsSyn
HsTypes
......
......@@ -538,6 +538,7 @@ compiler_stage2_dll0_MODULES = \
HsExpr \
HsImpExp \
HsLit \
PlaceHolder \
HsPat \
HsSyn \
HsTypes \
......
......@@ -140,7 +140,7 @@ cvtDec (TH.ValD pat body ds)
; ds' <- cvtLocalDecs (ptext (sLit "a where clause")) ds
; returnL $ Hs.ValD $
PatBind { pat_lhs = pat', pat_rhs = GRHSs body' ds'
, pat_rhs_ty = void, bind_fvs = placeHolderNames
, pat_rhs_ty = placeHolderType, bind_fvs = placeHolderNames
, pat_ticks = (Nothing,[]) } }
cvtDec (TH.FunD nm cls)
......@@ -181,7 +181,8 @@ cvtDec (DataD ctxt tc tvs constrs derivs)
, dd_kindSig = Nothing
, dd_cons = cons', dd_derivs = derivs' }
; returnL $ TyClD (DataDecl { tcdLName = tc', tcdTyVars = tvs'
, tcdDataDefn = defn, tcdFVs = placeHolderNames }) }
, tcdDataDefn = defn
, tcdFVs = placeHolderNames }) }
cvtDec (NewtypeD ctxt tc tvs constr derivs)
= do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
......@@ -192,7 +193,8 @@ cvtDec (NewtypeD ctxt tc tvs constr derivs)
, dd_kindSig = Nothing
, dd_cons = [con'], dd_derivs = derivs' }
; returnL $ TyClD (DataDecl { tcdLName = tc', tcdTyVars = tvs'
, tcdDataDefn = defn, tcdFVs = placeHolderNames }) }
, tcdDataDefn = defn
, tcdFVs = placeHolderNames }) }
cvtDec (ClassD ctxt cl tvs fds decs)
= do { (cxt', tc', tvs') <- cvt_tycl_hdr ctxt cl tvs
......@@ -248,7 +250,8 @@ cvtDec (DataInstD ctxt tc tys constrs derivs)
; returnL $ InstD $ DataFamInstD
{ dfid_inst = DataFamInstDecl { dfid_tycon = tc', dfid_pats = typats'
, dfid_defn = defn, dfid_fvs = placeHolderNames } }}
, dfid_defn = defn
, dfid_fvs = placeHolderNames } }}
cvtDec (NewtypeInstD ctxt tc tys constr derivs)
= do { (ctxt', tc', typats') <- cvt_tyinst_hdr ctxt tc tys
......@@ -260,7 +263,8 @@ cvtDec (NewtypeInstD ctxt tc tys constr derivs)
, dd_cons = [con'], dd_derivs = derivs' }
; returnL $ InstD $ DataFamInstD
{ dfid_inst = DataFamInstDecl { dfid_tycon = tc', dfid_pats = typats'
, dfid_defn = defn, dfid_fvs = placeHolderNames } }}
, dfid_defn = defn
, dfid_fvs = placeHolderNames } }}
cvtDec (TySynInstD tc eqn)
= do { tc' <- tconNameL tc
......@@ -327,7 +331,7 @@ cvt_tycl_hdr cxt tc tvs
cvt_tyinst_hdr :: TH.Cxt -> TH.Name -> [TH.Type]
-> CvtM ( LHsContext RdrName
, Located RdrName
, HsWithBndrs [LHsType RdrName])
, HsWithBndrs RdrName [LHsType RdrName])
cvt_tyinst_hdr cxt tc tys
= do { cxt' <- cvtContext cxt
; tc' <- tconNameL tc
......@@ -596,7 +600,9 @@ cvtl e = wrapL (cvt e)
cvt (ListE xs)
| Just s <- allCharLs xs = do { l' <- cvtLit (StringL s); return (HsLit l') }
-- Note [Converting strings]
| otherwise = do { xs' <- mapM cvtl xs; return $ ExplicitList void Nothing xs' }
| otherwise = do { xs' <- mapM cvtl xs
; return $ ExplicitList placeHolderType Nothing xs'
}
-- Infix expressions
cvt (InfixE (Just x) s (Just y)) = do { x' <- cvtl x; s' <- cvtl s; y' <- cvtl y
......@@ -734,7 +740,7 @@ cvtHsDo do_or_lc stmts
L loc (BodyStmt body _ _ _) -> return (L loc (mkLastStmt body))
_ -> failWith (bad_last last')
; return $ HsDo do_or_lc (stmts'' ++ [last'']) void }
; return $ HsDo do_or_lc (stmts'' ++ [last'']) placeHolderType }
where
bad_last stmt = vcat [ ptext (sLit "Illegal last statement of") <+> pprAStmtContext do_or_lc <> colon
, nest 2 $ Outputable.ppr stmt
......@@ -850,13 +856,16 @@ cvtp (ParensP p) = do { p' <- cvtPat p; return $ ParPat p' }
cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat p' }
cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat p' }
cvtp (TH.AsP s p) = do { s' <- vNameL s; p' <- cvtPat p; return $ AsPat s' p' }
cvtp TH.WildP = return $ WildPat void
cvtp TH.WildP = return $ WildPat placeHolderType
cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
; return $ ConPatIn c' $ Hs.RecCon (HsRecFields fs' Nothing) }
cvtp (ListP ps) = do { ps' <- cvtPats ps; return $ ListPat ps' void Nothing }
; return $ ConPatIn c'
$ Hs.RecCon (HsRecFields fs' Nothing) }
cvtp (ListP ps) = do { ps' <- cvtPats ps
; return $ ListPat ps' placeHolderType Nothing }
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
; return $ SigPatIn p' (mkHsWithBndrs t') }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p; return $ ViewPat e' p' void }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; return $ ViewPat e' p' placeHolderType }
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (HsRecField RdrName (LPat RdrName))
cvtPatFld (s,p)
......@@ -1032,9 +1041,6 @@ overloadedLit (IntegerL _) = True
overloadedLit (RationalL _) = True
overloadedLit _ = False
void :: Type.Type
void = placeHolderType
cvtFractionalLit :: Rational -> FractionalLit
cvtFractionalLit r = FL { fl_text = show (fromRational r :: Double), fl_value = r }
......
......@@ -8,6 +8,11 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
\begin{code}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
module HsBinds where
......@@ -16,7 +21,7 @@ import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr,
GRHSs, pprPatBind )
import {-# SOURCE #-} HsPat ( LPat )
import HsLit
import PlaceHolder ( PostTc,PostRn,DataId )
import HsTypes
import PprCore ()
import CoreSyn
......@@ -64,7 +69,9 @@ data HsLocalBindsLR idL idR
= HsValBinds (HsValBindsLR idL idR)
| HsIPBinds (HsIPBinds idR)
| EmptyLocalBinds
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId idL, DataId idR)
=> Data (HsLocalBindsLR idL idR)
type HsValBinds id = HsValBindsLR id id
......@@ -83,7 +90,9 @@ data HsValBindsLR idL idR
| ValBindsOut
[(RecFlag, LHsBinds idL)]
[LSig Name]
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId idL, DataId idR)
=> Data (HsValBindsLR idL idR)
type LHsBind id = LHsBindLR id id
type LHsBinds id = LHsBindsLR id id
......@@ -124,7 +133,8 @@ data HsBindLR idL idR
-- type Int -> forall a'. a' -> a'
-- Notice that the coercion captures the free a'.
bind_fvs :: NameSet, -- ^ After the renamer, this contains the locally-bound
bind_fvs :: PostRn idL NameSet, -- ^ After the renamer, this contains
-- the locally-bound
-- free variables of this defn.
-- See Note [Bind free vars]
......@@ -137,8 +147,8 @@ data HsBindLR idL idR
| PatBind {
pat_lhs :: LPat idL,
pat_rhs :: GRHSs idR (LHsExpr idR),
pat_rhs_ty :: PostTcType, -- ^ Type of the GRHSs
bind_fvs :: NameSet, -- ^ See Note [Bind free vars]
pat_rhs_ty :: PostTc idR Type, -- ^ Type of the GRHSs
bind_fvs :: PostRn idL NameSet, -- ^ See Note [Bind free vars]
pat_ticks :: (Maybe (Tickish Id), [Maybe (Tickish Id)])
-- ^ Tick to put on the rhs, if any, and ticks to put on
-- the bound variables.
......@@ -168,7 +178,10 @@ data HsBindLR idL idR
| PatSynBind (PatSynBind idL idR)
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId idL, DataId idR)
=> Data (HsBindLR idL idR)
-- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
--
-- Creates bindings for (polymorphic, overloaded) poly_f
......@@ -191,15 +204,14 @@ data ABExport id
data PatSynBind idL idR
= PSB { psb_id :: Located idL, -- ^ Name of the pattern synonym
psb_fvs :: NameSet, -- ^ See Note [Bind free vars]
psb_fvs :: PostRn idR NameSet, -- ^ See Note [Bind free vars]
psb_args :: HsPatSynDetails (Located idR), -- ^ Formal parameter names
psb_def :: LPat idR, -- ^ Right-hand side
psb_dir :: HsPatSynDir idR -- ^ Directionality
} deriving (Data, Typeable)
} deriving (Typeable)
deriving instance (DataId idL, DataId idR )
=> Data (PatSynBind idL idR)
-- | Used for the NameSet in FunBind and PatBind prior to the renamer
placeHolderNames :: NameSet
placeHolderNames = panic "placeHolderNames"
\end{code}
Note [AbsBinds]
......@@ -500,7 +512,8 @@ data HsIPBinds id
[LIPBind id]
TcEvBinds -- Only in typechecker output; binds
-- uses of the implicit parameters
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (HsIPBinds id)
isEmptyIPBinds :: HsIPBinds id -> Bool
isEmptyIPBinds (IPBinds is ds) = null is && isEmptyTcEvBinds ds
......@@ -514,7 +527,8 @@ that way until after type-checking when they are replaced with
evidene for the implicit parameter. -}
data IPBind id
= IPBind (Either HsIPName id) (LHsExpr id)
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId name) => Data (IPBind name)
instance (OutputableBndr id) => Outputable (HsIPBinds id) where
ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)
......@@ -605,7 +619,8 @@ data Sig name
-- > {-# MINIMAL a | (b, c | (d | e)) #-}
| MinimalSig (BooleanFormula (Located name))
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId name) => Data (Sig name)
type LFixitySig name = Located (FixitySig name)
......@@ -795,5 +810,6 @@ data HsPatSynDir id
= Unidirectional
| ImplicitBidirectional
| ExplicitBidirectional (MatchGroup id (LHsExpr id))
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (HsPatSynDir id)
\end{code}
......@@ -6,6 +6,11 @@
\begin{code}
{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable,
DeriveTraversable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
-- | Abstract syntax of global declarations.
--
......@@ -76,11 +81,12 @@ import HsPat
import HsTypes
import HsDoc
import TyCon
import NameSet
import Name
import BasicTypes
import Coercion
import ForeignCall
import PlaceHolder ( PostTc,PostRn,PlaceHolder(..),DataId )
import NameSet
-- others:
import InstEnv
......@@ -91,7 +97,7 @@ import SrcLoc
import FastString
import Bag
import Data.Data hiding (TyCon)
import Data.Data hiding (TyCon,Fixity)
import Data.Foldable (Foldable)
import Data.Traversable
import Data.Maybe
......@@ -123,7 +129,8 @@ data HsDecl id
| DocD (DocDecl)
| QuasiQuoteD (HsQuasiQuote id)
| RoleAnnotD (RoleAnnotDecl id)
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (HsDecl id)
-- NB: all top-level fixity decls are contained EITHER
......@@ -169,7 +176,8 @@ data HsGroup id
hs_vects :: [LVectDecl id],
hs_docs :: [LDocDecl]
} deriving (Data, Typeable)
} deriving (Typeable)
deriving instance (DataId id) => Data (HsGroup id)
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
......@@ -289,7 +297,8 @@ data SpliceDecl id
(Located (HsSplice id))
HsExplicitFlag -- Explicit <=> $(f x y)
-- Implicit <=> f x y, i.e. a naked top level expression
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (SpliceDecl id)
instance OutputableBndr name => Outputable (SpliceDecl name) where
ppr (SpliceDecl (L _ e) _) = pprUntypedSplice e
......@@ -453,7 +462,7 @@ data TyClDecl name
, tcdTyVars :: LHsTyVarBndrs name -- ^ Type variables; for an associated type
-- these include outer binders
, tcdRhs :: LHsType name -- ^ RHS of type declaration
, tcdFVs :: NameSet }
, tcdFVs :: PostRn name NameSet }
| -- | @data@ declaration
DataDecl { tcdLName :: Located name -- ^ Type constructor
......@@ -465,7 +474,7 @@ data TyClDecl name
-- Here the type decl for 'f' includes 'a'
-- in its tcdTyVars
, tcdDataDefn :: HsDataDefn name
, tcdFVs :: NameSet }
, tcdFVs :: PostRn name NameSet }
| ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
tcdLName :: Located name, -- ^ Name of the class
......@@ -476,10 +485,11 @@ data TyClDecl name
tcdATs :: [LFamilyDecl name], -- ^ Associated types; ie
tcdATDefs :: [LTyFamDefltEqn name], -- ^ Associated type defaults
tcdDocs :: [LDocDecl], -- ^ Haddock docs
tcdFVs :: NameSet
tcdFVs :: PostRn name NameSet
}
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (TyClDecl id)
-- This is used in TcTyClsDecls to represent
-- strongly connected components of decls
......@@ -489,7 +499,8 @@ data TyClDecl name
data TyClGroup name
= TyClGroup { group_tyclds :: [LTyClDecl name]
, group_roles :: [LRoleAnnotDecl name] }
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (TyClGroup id)
tyClGroupConcat :: [TyClGroup name] -> [LTyClDecl name]
tyClGroupConcat = concatMap group_tyclds
......@@ -503,7 +514,8 @@ data FamilyDecl name = FamilyDecl
, fdLName :: Located name -- type constructor
, fdTyVars :: LHsTyVarBndrs name -- type variables
, fdKindSig :: Maybe (LHsKind name) } -- result kind
deriving( Data, Typeable )
deriving( Typeable )
deriving instance (DataId id) => Data (FamilyDecl id)
data FamilyInfo name
= DataFamily
......@@ -511,7 +523,8 @@ data FamilyInfo name
-- this list might be empty, if we're in an hs-boot file and the user
-- said "type family Foo x where .."
| ClosedTypeFamily [LTyFamInstEqn name]
deriving( Data, Typeable )
deriving( Typeable )
deriving instance (DataId name) => Data (FamilyInfo name)
\end{code}
......@@ -789,7 +802,8 @@ data HsDataDefn name -- The payload of a data type defn
-- Typically the foralls and ty args are empty, but they
-- are non-empty for the newtype-deriving case
}
deriving( Data, Typeable )
deriving( Typeable )
deriving instance (DataId id) => Data (HsDataDefn id)
data NewOrData
= NewType -- ^ @newtype Blah ...@
......@@ -847,7 +861,8 @@ data ConDecl name
-- GADT-style record decl C { blah } :: T a b
-- Remove this when we no longer parse this stuff, and hence do not
-- need to report decprecated use
} deriving (Data, Typeable)
} deriving (Typeable)
deriving instance (DataId name) => Data (ConDecl name)
type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
......@@ -964,7 +979,7 @@ It is parameterised over its tfe_pats field:
type LTyFamInstEqn name = Located (TyFamInstEqn name)
type LTyFamDefltEqn name = Located (TyFamDefltEqn name)
type HsTyPats name = HsWithBndrs [LHsType name]
type HsTyPats name = HsWithBndrs name [LHsType name]
-- ^ Type patterns (with kind and type bndrs)
-- See Note [Family instance declaration binders]
......@@ -979,14 +994,16 @@ data TyFamEqn name pats
{ tfe_tycon :: Located name
, tfe_pats :: pats
, tfe_rhs :: LHsType name }
deriving( Typeable, Data )
deriving( Typeable )
deriving instance (DataId name, Data pats) => Data (TyFamEqn name pats)
type LTyFamInstDecl name = Located (TyFamInstDecl name)
data TyFamInstDecl name
= TyFamInstDecl
{ tfid_eqn :: LTyFamInstEqn name
, tfid_fvs :: NameSet }
deriving( Typeable, Data )
, tfid_fvs :: PostRn name NameSet }
deriving( Typeable )
deriving instance (DataId name) => Data (TyFamInstDecl name)
----------------- Data family instances -------------
......@@ -996,8 +1013,10 @@ data DataFamInstDecl name
{ dfid_tycon :: Located name
, dfid_pats :: HsTyPats name -- LHS
, dfid_defn :: HsDataDefn name -- RHS
, dfid_fvs :: NameSet } -- Rree vars for dependency analysis
deriving( Typeable, Data )
, dfid_fvs :: PostRn name NameSet } -- Rree vars for
-- dependency analysis
deriving( Typeable )
deriving instance (DataId name) => Data (DataFamInstDecl name)
----------------- Class instances -------------
......@@ -1014,7 +1033,8 @@ data ClsInstDecl name
, cid_datafam_insts :: [LDataFamInstDecl name] -- Data family instances
, cid_overlap_mode :: Maybe OverlapMode
}
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (ClsInstDecl id)
----------------- Instances of all kinds -------------
......@@ -1027,7 +1047,8 @@ data InstDecl name -- Both class and family instances
{ dfid_inst :: DataFamInstDecl name }
| TyFamInstD -- type family instance
{ tfid_inst :: TyFamInstDecl name }
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId id) => Data (InstDecl id)
\end{code}
Note [Family instance declaration binders]
......@@ -1148,7 +1169,8 @@ type LDerivDecl name = Located (DerivDecl name)
data DerivDecl name = DerivDecl { deriv_type :: LHsType name
, deriv_overlap_mode :: Maybe OverlapMode
}
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId name) => Data (DerivDecl name)
instance (OutputableBndr name) => Outputable (DerivDecl name) where
ppr (DerivDecl ty o)
......@@ -1170,7 +1192,8 @@ type LDefaultDecl name = Located (DefaultDecl name)
data DefaultDecl name
= DefaultDecl [LHsType name]
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId name) => Data (DefaultDecl name)
instance (OutputableBndr name)
=> Outputable (DefaultDecl name) where
......@@ -1198,13 +1221,14 @@ type LForeignDecl name = Located (ForeignDecl name)
data ForeignDecl name
= ForeignImport (Located name) -- defines this name
(LHsType name) -- sig_ty
Coercion -- rep_ty ~ sig_ty
(PostTc name Coercion) -- rep_ty ~ sig_ty
ForeignImport
| ForeignExport (Located name) -- uses this name
(LHsType name) -- sig_ty
Coercion -- sig_ty ~ rep_ty
(PostTc name Coercion) -- sig_ty ~ rep_ty
ForeignExport
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId name) => Data (ForeignDecl name)
{-
In both ForeignImport and ForeignExport:
sig_ty is the type given in the Haskell code
......@@ -1214,13 +1238,11 @@ data ForeignDecl name
such as Int and IO that we know how to make foreign calls with.
-}
noForeignImportCoercionYet :: Coercion
noForeignImportCoercionYet
= panic "ForeignImport coercion evaluated before typechecking"
noForeignImportCoercionYet :: PlaceHolder
noForeignImportCoercionYet = PlaceHolder
noForeignExportCoercionYet :: Coercion
noForeignExportCoercionYet
= panic "ForeignExport coercion evaluated before typechecking"
noForeignExportCoercionYet :: PlaceHolder
noForeignExportCoercionYet = PlaceHolder
-- Specification Of an imported external entity in dependence on the calling
-- convention
......@@ -1311,17 +1333,19 @@ data RuleDecl name
Activation
[RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
(Located (HsExpr name)) -- LHS
NameSet -- Free-vars from the LHS
(PostRn name NameSet) -- Free-vars from the LHS
(Located (HsExpr name)) -- RHS
NameSet -- Free-vars from the RHS
deriving (Data, Typeable)
(PostRn name NameSet) -- Free-vars from the RHS
deriving (Typeable)
deriving instance (DataId name) => Data (RuleDecl name)
data RuleBndr name
= RuleBndr (Located name)
| RuleBndrSig (Located name) (HsWithBndrs (LHsType name))
deriving (Data, Typeable)
| RuleBndrSig (Located name) (HsWithBndrs name (LHsType name))
deriving (Typeable)
deriving instance (DataId name) => Data (RuleBndr name)
collectRuleBndrSigTys :: [RuleBndr name] -> [HsWithBndrs (LHsType name)]
collectRuleBndrSigTys :: [RuleBndr name] -> [HsWithBndrs name (LHsType name)]
collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
instance OutputableBndr name => Outputable (RuleDecl name) where
......@@ -1379,7 +1403,8 @@ data VectDecl name
(LHsType name)
| HsVectInstOut -- post type-checking (always SCALAR) !!!FIXME: should be superfluous now
ClsInst
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId name) => Data (VectDecl name)
lvectDeclName :: NamedThing name => LVectDecl name -> Name
lvectDeclName (L _ (HsVect (L _ name) _)) = getName name
......@@ -1487,7 +1512,8 @@ instance OutputableBndr name => Outputable (WarnDecl name) where
type LAnnDecl name = Located (AnnDecl name)
data AnnDecl name = HsAnnotation (AnnProvenance name) (Located (HsExpr name))
deriving (Data, Typeable)
deriving (Typeable)
deriving instance (DataId name) => Data (AnnDecl name)