\begin{code}
module TcClassDcl ( tcClassSigs, tcClassDecl2,
- findMethodBind, tcInstanceMethodBody,
- mkGenericDefMethBind, getGenericInstances, mkDefMethRdrName,
+ findMethodBind, instantiateMethod, tcInstanceMethodBody,
+ mkGenericDefMethBind, getGenericInstances,
tcAddDeclCtxt, badMethodErr, badATErr, omittedATWarn
) where
import HsSyn
import RnHsSyn
-import RnExpr
-import RnEnv
import Inst
import InstEnv
import TcEnv
import TcBinds
-import TcSimplify
+import TcUnify
import TcHsType
import TcMType
import TcType
import TcRnMonad
+import BuildTyCl( TcMethInfo )
import Generics
import Class
import TyCon
-import Type
import MkId
import Id
import Name
import Var
-import NameEnv
import NameSet
-import OccName
-import RdrName
import Outputable
import PrelNames
import DynFlags
import ErrUtils
import Util
-import Unique
import ListSetOps
import SrcLoc
import Maybes
-import List
import BasicTypes
import Bag
import FastString
import Control.Monad
+import Data.List
\end{code}
tcClassSigs :: Name -- Name of the class
-> [LSig Name]
-> LHsBinds Name
- -> TcM [TcMethInfo]
+ -> TcM [TcMethInfo] -- One for each method
-type TcMethInfo = (Name, DefMeth, Type) -- A temporary intermediate, to communicate
- -- between tcClassSigs and buildClass
tcClassSigs clas sigs def_methods
- = do { dm_env <- checkDefaultBinds clas op_names def_methods
- ; mapM (tcClassSig dm_env) op_sigs }
- where
- op_sigs = [sig | sig@(L _ (TypeSig _ _)) <- sigs]
- op_names = [n | (L _ (TypeSig (L _ n) _)) <- op_sigs]
-
-
-checkDefaultBinds :: Name -> [Name] -> LHsBinds Name -> TcM (NameEnv Bool)
- -- Check default bindings
- -- a) must be for a class op for this class
- -- b) must be all generic or all non-generic
- -- and return a mapping from class-op to Bool
- -- where True <=> it's a generic default method
-checkDefaultBinds clas ops binds
- = do dm_infos <- mapM (addLocM (checkDefaultBind clas ops)) (bagToList binds)
- return (mkNameEnv dm_infos)
-
-checkDefaultBind :: Name -> [Name] -> HsBindLR Name Name -> TcM (Name, Bool)
-checkDefaultBind clas ops (FunBind {fun_id = L _ op, fun_matches = MatchGroup matches _ })
- = do { -- Check that the op is from this class
- checkTc (op `elem` ops) (badMethodErr clas op)
-
- -- Check that all the defns ar generic, or none are
- ; checkTc (all_generic || none_generic) (mixedGenericErr op)
-
- ; return (op, all_generic)
- }
+ = do { -- Check that all def_methods are in the class
+ ; op_info <- mapM (addLocM tc_sig) [sig | sig@(L _ (TypeSig _ _)) <- sigs]
+ ; let op_names = [ n | (n,_,_) <- op_info ]
+
+ ; sequence_ [ failWithTc (badMethodErr clas n)
+ | n <- dm_bind_names, not (n `elem` op_names) ]
+ -- Value binding for non class-method (ie no TypeSig)
+
+ ; sequence_ [ failWithTc (badGenericMethod clas n)
+ | n <- genop_names, not (n `elem` dm_bind_names) ]
+ -- Generic signature without value binding
+
+ ; return op_info }
where
- n_generic = count (isJust . maybeGenericMatch) matches
- none_generic = n_generic == 0
- all_generic = matches `lengthIs` n_generic
-checkDefaultBind _ _ b = pprPanic "checkDefaultBind" (ppr b)
-
-
-tcClassSig :: NameEnv Bool -- Info about default methods;
- -> LSig Name
- -> TcM TcMethInfo
-
-tcClassSig dm_env (L loc (TypeSig (L _ op_name) op_hs_ty))
- = setSrcSpan loc $ do
- { op_ty <- tcHsKindedType op_hs_ty -- Class tyvars already in scope
- ; let dm = case lookupNameEnv dm_env op_name of
- Nothing -> NoDefMeth
- Just False -> DefMeth
- Just True -> GenDefMeth
- ; return (op_name, dm, op_ty) }
-tcClassSig _ s = pprPanic "tcClassSig" (ppr s)
+ dm_bind_names :: [Name] -- These ones have a value binding in the class decl
+ dm_bind_names = [op | L _ (FunBind {fun_id = L _ op}) <- bagToList def_methods]
+
+ genop_names :: [Name] -- These ones have a generic signature
+ genop_names = [n | L _ (GenericSig (L _ n) _) <- sigs]
+
+ tc_sig (TypeSig (L _ op_name) op_hs_ty)
+ = do { op_ty <- tcHsKindedType op_hs_ty -- Class tyvars already in scope
+ ; let dm | op_name `elem` genop_names = GenericDM
+ | op_name `elem` dm_bind_names = VanillaDM
+ | otherwise = NoDM
+ ; return (op_name, dm, op_ty) }
+ tc_sig sig = pprPanic "tc_cls_sig" (ppr sig)
\end{code}
\begin{code}
tcClassDecl2 :: LTyClDecl Name -- The class declaration
- -> TcM (LHsBinds Id, [Id])
+ -> TcM (LHsBinds Id)
tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs,
tcdMeths = default_binds}))
- = recoverM (return (emptyLHsBinds, [])) $
- setSrcSpan loc $
+ = recoverM (return emptyLHsBinds) $
+ setSrcSpan loc $
do { clas <- tcLookupLocatedClass class_name
-- We make a separate binding for each default method.
-- default methods. Better to make separate AbsBinds for each
; let
(tyvars, _, _, op_items) = classBigSig clas
- rigid_info = ClsSkol clas
- prag_fn = mkPragFun sigs
- sig_fn = mkTcSigFun sigs
- clas_tyvars = tcSkolSigTyVars rigid_info tyvars
+ prag_fn = mkPragFun sigs default_binds
+ sig_fn = mkSigFun sigs
+ clas_tyvars = tcSuperSkolTyVars tyvars
pred = mkClassPred clas (mkTyVarTys clas_tyvars)
- ; inst_loc <- getInstLoc (SigOrigin rigid_info)
- ; this_dict <- newDictBndr inst_loc pred
+ ; this_dict <- newEvVar pred
- ; let tc_dm = tcDefMeth rigid_info clas clas_tyvars [pred]
- this_dict default_binds
+ ; traceTc "TIM2" (ppr sigs)
+ ; let tc_dm = tcDefMeth clas clas_tyvars
+ this_dict default_binds sigs
sig_fn prag_fn
- -- tc_dm is called only for a sel_id
- -- that has a binding in default_binds
- dm_sel_ids = [sel_id | (sel_id, DefMeth) <- op_items]
- -- Generate code for polymorphic default methods only (hence DefMeth)
- -- (Generic default methods have turned into instance decls by now.)
- -- This is incompatible with Hugs, which expects a polymorphic
- -- default method for every class op, regardless of whether or not
- -- the programmer supplied an explicit default decl for the class.
- -- (If necessary we can fix that, but we don't have a convenient Id to hand.)
+ ; dm_binds <- tcExtendTyVarEnv clas_tyvars $
+ mapM tc_dm op_items
- ; (defm_binds, dm_ids) <- tcExtendTyVarEnv clas_tyvars $
- mapAndUnzipM tc_dm dm_sel_ids
-
- ; return (unionManyBags defm_binds, dm_ids) }
+ ; return (unionManyBags dm_binds) }
tcClassDecl2 d = pprPanic "tcClassDecl2" (ppr d)
-tcDefMeth :: SkolemInfo -> Class -> [TyVar] -> ThetaType -> Inst -> LHsBinds Name
- -> TcSigFun -> TcPragFun -> Id
- -> TcM (LHsBinds Id, Id)
-tcDefMeth rigid_info clas tyvars theta this_dict binds_in sig_fn prag_fn sel_id
- = do { let sel_name = idName sel_id
- ; local_dm_name <- newLocalName sel_name
- ; let meth_bind = findMethodBind sel_name local_dm_name binds_in
- `orElse` pprPanic "tcDefMeth" (ppr sel_id)
- -- We only call tcDefMeth on selectors for which
- -- there is a binding in binds_in
-
- meth_sig_fn _ = sig_fn sel_name
- meth_prag_fn _ = prag_fn sel_name
-
- ; (top_dm_id, bind) <- tcInstanceMethodBody rigid_info
- clas tyvars [this_dict] theta (mkTyVarTys tyvars)
- Nothing sel_id
- local_dm_name
- meth_sig_fn meth_prag_fn
- meth_bind
-
- ; return (bind, top_dm_id) }
-
-mkDefMethRdrName :: Name -> RdrName
-mkDefMethRdrName sel_name = mkDerivedRdrName sel_name mkDefaultMethodOcc
+tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds Name -> [LSig Name]
+ -> SigFun -> PragFun -> ClassOpItem
+ -> TcM (LHsBinds TcId)
+-- Generate code for polymorphic default methods only (hence DefMeth)
+-- (Generic default methods have turned into instance decls by now.)
+-- This is incompatible with Hugs, which expects a polymorphic
+-- default method for every class op, regardless of whether or not
+-- the programmer supplied an explicit default decl for the class.
+-- (If necessary we can fix that, but we don't have a convenient Id to hand.)
+tcDefMeth _ tyvars _ binds_in sigs sig_fn prag_fn (sel_id, dm_info)
+ | NoDefMeth <- dm_info = return emptyBag
+ | otherwise
+ = do { (dm_id, tvs, sig_loc) <- tc_dm_id dm_info
+ ; let L loc meth_bind = findMethodBind sel_name binds_in
+ `orElse` pprPanic "tcDefMeth" (ppr sel_id)
+ dm_bind = L loc (meth_bind { fun_id = L loc (idName dm_id) })
+ -- Substitute the meth_name for the binder
+ -- NB: the binding is always a FunBind
+
+ dm_sig_fn _ = Just (clas_tv_names ++ tvs, sig_loc)
+ dm_prag_fn _ = prag_fn sel_name
+
+ ; (binds,_) <- tcExtendIdEnv [dm_id] $
+ tcPolyBinds TopLevel dm_sig_fn dm_prag_fn
+ NonRecursive NonRecursive
+ [dm_bind]
+ ; return binds }
+ where
+ sel_name = idName sel_id
+ clas_tv_names = map getName tyvars
+
+ -- Find the 'generic op :: ty' signature among the sigs
+ -- If dm_info is GenDefMeth, the corresponding signature
+ -- should jolly well exist! Hence the panic
+ genop_lhs_ty = case [lty | L _ (GenericSig (L _ n) lty) <- sigs
+ , n == sel_name ] of
+ [lty] -> lty
+ _ -> pprPanic "tcDefMeth" (ppr sel_name $$ ppr sigs)
+
+ tc_dm_id :: DefMeth -> TcM (Id, [Name], SrcSpan)
+ -- Make a default-method Id of the appropriate type
+ -- That may entail getting the generic-default signature
+ -- from the type signatures.
+ -- Also return the in-scope tyvars for the default method, and their binding site
+ tc_dm_id NoDefMeth = panic "tc_dm_id"
+ tc_dm_id (DefMeth dm_name)
+ | Just (tvs, loc) <- sig_fn sel_name
+ = return (mkDefaultMethodId sel_id dm_name, tvs, loc)
+ | otherwise
+ = pprPanic "No sig for" (ppr sel_name)
+ tc_dm_id (GenDefMeth dm_name)
+ = setSrcSpan loc $
+ do { tau <- tcHsKindedType genop_lhs_ty
+ ; checkValidType (FunSigCtxt sel_name) tau
+ ; return ( mkExportedLocalId dm_name (mkForAllTys tyvars tau)
+ , hsExplicitTvs genop_lhs_ty, loc ) }
+ where
+ loc = getLoc genop_lhs_ty
+
+---------------
+tcInstanceMethodBody :: SkolemInfo -> [TcTyVar] -> [EvVar]
+ -> Id -> Id
+ -> SigFun -> TcSpecPrags -> LHsBind Name
+ -> TcM (LHsBind Id)
+tcInstanceMethodBody skol_info tyvars dfun_ev_vars
+ meth_id local_meth_id
+ meth_sig_fn specs
+ (L loc bind)
+ = do { -- Typecheck the binding, first extending the envt
+ -- so that when tcInstSig looks up the local_meth_id to find
+ -- its signature, we'll find it in the environment
+ let lm_bind = L loc (bind { fun_id = L loc (idName local_meth_id) })
+ -- Substitute the local_meth_name for the binder
+ -- NB: the binding is always a FunBind
+ ; traceTc "TIM" (ppr local_meth_id $$ ppr (meth_sig_fn (idName local_meth_id)))
+ ; (ev_binds, (tc_bind, _))
+ <- checkConstraints skol_info tyvars dfun_ev_vars $
+ tcExtendIdEnv [local_meth_id] $
+ tcPolyBinds TopLevel meth_sig_fn no_prag_fn
+ NonRecursive NonRecursive
+ [lm_bind]
+
+ ; let full_bind = AbsBinds { abs_tvs = tyvars, abs_ev_vars = dfun_ev_vars
+ , abs_exports = [(tyvars, meth_id, local_meth_id, specs)]
+ , abs_ev_binds = ev_binds
+ , abs_binds = tc_bind }
+
+ ; return (L loc full_bind) }
+ where
+ no_prag_fn _ = [] -- No pragmas for local_meth_id;
+ -- they are all for meth_id
+\end{code}
+
+\begin{code}
+instantiateMethod :: Class -> Id -> [TcType] -> TcType
+-- Take a class operation, say
+-- op :: forall ab. C a => forall c. Ix c => (b,c) -> a
+-- Instantiate it at [ty1,ty2]
+-- Return the "local method type":
+-- forall c. Ix x => (ty2,c) -> ty1
+instantiateMethod clas sel_id inst_tys
+ = ASSERT( ok_first_pred ) local_meth_ty
+ where
+ (sel_tyvars,sel_rho) = tcSplitForAllTys (idType sel_id)
+ rho_ty = ASSERT( length sel_tyvars == length inst_tys )
+ substTyWith sel_tyvars inst_tys sel_rho
+
+ (first_pred, local_meth_ty) = tcSplitPredFunTy_maybe rho_ty
+ `orElse` pprPanic "tcInstanceMethod" (ppr sel_id)
+
+ ok_first_pred = case getClassPredTys_maybe first_pred of
+ Just (clas1, _tys) -> clas == clas1
+ Nothing -> False
+ -- The first predicate should be of form (C a b)
+ -- where C is the class in question
+
---------------------------
--- The renamer just puts the selector ID as the binder in the method binding
--- but we must use the method name; so we substitute it here. Crude but simple.
-findMethodBind :: Name -> Name -- Selector and method name
+findMethodBind :: Name -- Selector name
-> LHsBinds Name -- A group of bindings
- -> Maybe (LHsBind Name) -- The binding, with meth_name replacing sel_name
-findMethodBind sel_name meth_name binds
+ -> Maybe (LHsBind Name) -- The binding
+findMethodBind sel_name binds
= foldlBag mplus Nothing (mapBag f binds)
where
- f (L loc1 bind@(FunBind { fun_id = L loc2 op_name }))
- | op_name == sel_name
- = Just (L loc1 (bind { fun_id = L loc2 meth_name }))
- f _other = Nothing
-
----------------
-tcInstanceMethodBody :: SkolemInfo -> Class -> [TcTyVar] -> [Inst]
- -> TcThetaType -> [TcType]
- -> Maybe (Inst, LHsBind Id) -> Id
- -> Name -- The local method name
- -> TcSigFun -> TcPragFun -> LHsBind Name
- -> TcM (Id, LHsBinds Id)
-tcInstanceMethodBody rigid_info clas tyvars dfun_dicts theta inst_tys
- mb_this_bind sel_id local_meth_name
- sig_fn prag_fn bind@(L loc _)
- = do { let (sel_tyvars,sel_rho) = tcSplitForAllTys (idType sel_id)
- rho_ty = ASSERT( length sel_tyvars == length inst_tys )
- substTyWith sel_tyvars inst_tys sel_rho
-
- (first_pred, local_meth_ty) = tcSplitPredFunTy_maybe rho_ty
- `orElse` pprPanic "tcInstanceMethod" (ppr sel_id)
-
- local_meth_id = mkLocalId local_meth_name local_meth_ty
- meth_ty = mkSigmaTy tyvars theta local_meth_ty
- sel_name = idName sel_id
-
- -- The first predicate should be of form (C a b)
- -- where C is the class in question
- ; MASSERT( case getClassPredTys_maybe first_pred of
- { Just (clas1, _tys) -> clas == clas1 ; Nothing -> False } )
-
- -- Typecheck the binding, first extending the envt
- -- so that when tcInstSig looks up the local_meth_id to find
- -- its signature, we'll find it in the environment
- ; ((tc_bind, _), lie) <- getLIE $
- tcExtendIdEnv [local_meth_id] $
- tcPolyBinds TopLevel sig_fn prag_fn
- NonRecursive NonRecursive
- (unitBag bind)
-
- ; meth_id <- case rigid_info of
- ClsSkol _ -> do { dm_name <- lookupTopBndrRn (mkDefMethRdrName sel_name)
- ; return (mkDefaultMethodId dm_name meth_ty) }
- _other -> do { meth_name <- newLocalName sel_name
- ; return (mkLocalId meth_name meth_ty) }
-
- ; let (avails, this_dict_bind)
- = case mb_this_bind of
- Nothing -> (dfun_dicts, emptyBag)
- Just (this, bind) -> (this : dfun_dicts, unitBag bind)
-
- ; inst_loc <- getInstLoc (SigOrigin rigid_info)
- ; lie_binds <- tcSimplifyCheck inst_loc tyvars avails lie
-
- ; let full_bind = L loc $
- AbsBinds tyvars dfun_lam_vars
- [(tyvars, meth_id, local_meth_id, [])]
- (this_dict_bind `unionBags` lie_binds
- `unionBags` tc_bind)
-
- dfun_lam_vars = map instToVar dfun_dicts -- Includes equalities
-
- ; return (meth_id, unitBag full_bind) }
+ f bind@(L _ (FunBind { fun_id = L _ op_name }))
+ | op_name == sel_name
+ = Just bind
+ f _other = Nothing
\end{code}
Note [Polymorphic methods]
instance C 1 where
op Unit = ...
-
\begin{code}
mkGenericDefMethBind :: Class -> [Type] -> Id -> Name -> TcM (LHsBind Name)
-mkGenericDefMethBind clas inst_tys sel_id meth_name
+mkGenericDefMethBind clas inst_tys sel_id dm_name
= -- A generic default method
- -- If the method is defined generically, we can only do the job if the
- -- instance declaration is for a single-parameter type class with
- -- a type constructor applied to type arguments in the instance decl
- -- (checkTc, so False provokes the error)
- do { checkTc (isJust maybe_tycon)
- (badGenericInstance sel_id (notSimple inst_tys))
- ; checkTc (tyConHasGenerics tycon)
- (badGenericInstance sel_id (notGeneric tycon))
-
- ; dflags <- getDOpts
+ -- If the method is defined generically, we only have to call the
+ -- dm_name.
+ do { dflags <- getDOpts
; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
(vcat [ppr clas <+> ppr inst_tys,
nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
- -- Rename it before returning it
- ; (rn_rhs, _) <- rnLExpr rhs
- ; return (noLoc $ mkFunBind (noLoc meth_name) [mkSimpleMatch [] rn_rhs]) }
+ ; return (noLoc $ mkFunBind (noLoc (idName sel_id))
+ [mkSimpleMatch [] rhs]) }
where
- rhs = mkGenericRhs sel_id clas_tyvar tycon
-
- -- The tycon is only used in the generic case, and in that
- -- case we require that the instance decl is for a single-parameter
- -- type class with type variable arguments:
- -- instance (...) => C (T a b)
- clas_tyvar = ASSERT (not (null (classTyVars clas))) head (classTyVars clas)
- Just tycon = maybe_tycon
- maybe_tycon = case inst_tys of
- [ty] -> case tcSplitTyConApp_maybe ty of
- Just (tycon, arg_tys) | all tcIsTyVarTy arg_tys -> Just tycon
- _ -> Nothing
- _ -> Nothing
-
+ rhs = nlHsVar dm_name
---------------------------
getGenericInstances :: [LTyClDecl Name] -> TcM [InstInfo Name]
else do
-- Otherwise print it out
- { dflags <- getDOpts
- ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
- (vcat (map pprInstInfoDetails gen_inst_info)))
+ { dumpDerivingInfo $ hang (ptext (sLit "Generic instances"))
+ 2 (vcat (map pprInstInfoDetails gen_inst_info))
; return gen_inst_info }}
get_generics :: TyClDecl Name -> TcM [InstInfo Name]
group `lengthExceeds` 1]
get_uniq (tc,_) = getUnique tc
- mapM (addErrTc . dupGenericInsts) bad_groups
+ mapM_ (addErrTc . dupGenericInsts) bad_groups
-- Check that there is an InstInfo for each generic type constructor
let
-- and wrap them as forall'd tyvars, so that kind inference
-- works in the standard way
let
- sig_tvs = map (noLoc.UserTyVar) (nameSetToList (extractHsTyVars (noLoc hs_ty)))
+ sig_tvs = userHsTyVarBndrs $ map noLoc $ nameSetToList $
+ extractHsTyVars (noLoc hs_ty)
hs_forall_ty = noLoc $ mkExplicitHsForAllTy sig_tvs (noLoc []) (noLoc hs_ty)
-- Type-check the instance type, and check its form
let
inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
dfun_id = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
- ispec = mkLocalInstance dfun_id overlap_flag
+ ispec = mkLocalInstance dfun_id overlap_flag
- return (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] })
+ return (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] False })
\end{code}
= hsep [ptext (sLit "Class"), quotes (ppr clas),
ptext (sLit "does not have a method"), quotes (ppr op)]
+badGenericMethod :: Outputable a => a -> Name -> SDoc
+badGenericMethod clas op
+ = hsep [ptext (sLit "Class"), quotes (ppr clas),
+ ptext (sLit "has a generic-default signature without a binding"), quotes (ppr op)]
+
badATErr :: Class -> Name -> SDoc
badATErr clas at
= hsep [ptext (sLit "Class"), quotes (ppr clas),
omittedATWarn at
= ptext (sLit "No explicit AT declaration for") <+> quotes (ppr at)
-badGenericInstance :: Var -> SDoc -> SDoc
-badGenericInstance sel_id because
- = sep [ptext (sLit "Can't derive generic code for") <+> quotes (ppr sel_id),
- because]
-
-notSimple :: [Type] -> SDoc
-notSimple inst_tys
- = vcat [ptext (sLit "because the instance type(s)"),
- nest 2 (ppr inst_tys),
- ptext (sLit "is not a simple type of form (T a1 ... an)")]
-
-notGeneric :: TyCon -> SDoc
-notGeneric tycon
- = vcat [ptext (sLit "because the instance type constructor") <+> quotes (ppr tycon) <+>
- ptext (sLit "was not compiled with -XGenerics")]
-
badGenericInstanceType :: LHsBinds Name -> SDoc
badGenericInstanceType binds
= vcat [ptext (sLit "Illegal type pattern in the generic bindings"),
- nest 4 (ppr binds)]
+ nest 2 (ppr binds)]
missingGenericInstances :: [Name] -> SDoc
missingGenericInstances missing
dupGenericInsts :: [(TyCon, InstInfo a)] -> SDoc
dupGenericInsts tc_inst_infos
= vcat [ptext (sLit "More than one type pattern for a single generic type constructor:"),
- nest 4 (vcat (map ppr_inst_ty tc_inst_infos)),
+ nest 2 (vcat (map ppr_inst_ty tc_inst_infos)),
ptext (sLit "All the type patterns for a generic type constructor must be identical")
]
where
ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst)
-
-mixedGenericErr :: Name -> SDoc
-mixedGenericErr op
- = ptext (sLit "Can't mix generic and non-generic equations for class method") <+> quotes (ppr op)
\end{code}
projects / ghc-hetmet.git / blobdiff