Skip to content
GitLab
Commit 995d6dbf authored by sof's avatar sof
Browse files

[project @ 1997-05-18 22:57:44 by sof] 

new PP;2.04 update
parent 3b3e0e79
Expand all Hide whitespace changes
Inline Side-by-side
ghc/compiler/typecheck/Inst.lhs
View file @ 995d6dbf
......@@ -31,27 +31,30 @@ module Inst (
IMP_Ubiq()
IMPORT_1_3(Ratio(Rational))
import HsSyn ( HsLit(..), HsExpr(..), HsBinds, Fixity,
InPat, OutPat, Stmt, DoOrListComp, Match,
import HsSyn ( HsLit(..), HsExpr(..), HsBinds, Fixity, MonoBinds(..),
InPat, OutPat, Stmt, DoOrListComp, Match, GRHSsAndBinds,
ArithSeqInfo, HsType, Fake )
import RnHsSyn ( SYN_IE(RenamedArithSeqInfo), SYN_IE(RenamedHsExpr) )
import TcHsSyn ( TcIdOcc(..), SYN_IE(TcExpr), SYN_IE(TcIdBndr),
import TcHsSyn ( TcIdOcc(..), SYN_IE(TcExpr), SYN_IE(TcIdBndr),
SYN_IE(TcDictBinds), SYN_IE(TcMonoBinds),
mkHsTyApp, mkHsDictApp, tcIdTyVars )
import TcMonad
import TcEnv ( tcLookupGlobalValueByKey, tcLookupTyConByKey )
import TcType ( SYN_IE(TcType), SYN_IE(TcRhoType), TcMaybe, SYN_IE(TcTyVarSet),
tcInstType, zonkTcType )
tcInstType, zonkTcType, tcSplitForAllTy, tcSplitRhoTy )
import Bag ( emptyBag, unitBag, unionBags, unionManyBags, listToBag, consBag )
import Bag ( emptyBag, unitBag, unionBags, unionManyBags,
listToBag, consBag, Bag )
import Class ( classInstEnv,
SYN_IE(Class), GenClass, SYN_IE(ClassInstEnv), SYN_IE(ClassOp)
)
import ErrUtils ( addErrLoc, SYN_IE(Error) )
import Id ( GenId, idType, mkInstId )
import Id ( GenId, idType, mkInstId, SYN_IE(Id) )
import PrelInfo ( isCcallishClass, isNoDictClass )
import MatchEnv ( lookupMEnv, insertMEnv )
import Name ( OccName(..), Name, mkLocalName, mkSysLocalName, occNameString )
import Name ( OccName(..), Name, mkLocalName,
mkSysLocalName, occNameString, getOccName )
import Outputable
import PprType ( GenClass, TyCon, GenType, GenTyVar, pprParendGenType )
import PprStyle ( PprStyle(..) )
......@@ -61,7 +64,7 @@ import SrcLoc ( SrcLoc, noSrcLoc )
import Type ( GenType, eqSimpleTy, instantiateTy,
isTyVarTy, mkDictTy, splitForAllTy, splitSigmaTy,
splitRhoTy, matchTy, tyVarsOfType, tyVarsOfTypes,
mkSynTy
mkSynTy, SYN_IE(Type)
)
import TyVar ( unionTyVarSets, GenTyVar )
import TysPrim ( intPrimTy )
......@@ -70,6 +73,9 @@ import Unique ( showUnique, fromRationalClassOpKey, rationalTyConKey,
fromIntClassOpKey, fromIntegerClassOpKey, Unique
)
import Util ( panic, zipEqual, zipWithEqual, assoc, assertPanic, pprTrace{-ToDo:rm-} )
#if __GLASGOW_HASKELL__ >= 202
import Maybes
#endif
\end{code}
%************************************************************************
......@@ -198,8 +204,8 @@ newMethod orig id tys
in
(if length tyvars /= length tys then pprTrace "newMethod" (ppr PprDebug (idType id)) else \x->x) $
tcInstType (zip{-Equal "newMethod"-} tyvars tys) rho
TcId id -> let (tyvars, rho) = splitForAllTy (idType id)
in returnNF_Tc (instantiateTy (zipEqual "newMethod(2)" tyvars tys) rho)
TcId id -> tcSplitForAllTy (idType id) `thenNF_Tc` \ (tyvars, rho) ->
returnNF_Tc (instantiateTy (zipEqual "newMethod(2)" tyvars tys) rho)
) `thenNF_Tc` \ rho_ty ->
-- Our friend does the rest
newMethodWithGivenTy orig id tys rho_ty
......@@ -249,11 +255,13 @@ instToId (Dict u clas ty orig loc)
str = VarOcc (SLIT("d.") _APPEND_ (occNameString (getOccName clas)))
instToId (Method u id tys rho_ty orig loc)
= TcId (mkInstId u tau_ty (mkLocalName u str loc))
= TcId (mkInstId u tau_ty (mkLocalName u occ loc))
where
(_, tau_ty) = splitRhoTy rho_ty -- NB The method Id has just the tau type
str = VarOcc (SLIT("m.") _APPEND_ (occNameString (getOccName id)))
occ = getOccName id
(_, tau_ty) = splitRhoTy rho_ty
-- I hope we don't need tcSplitRhoTy...
-- NB The method Id has just the tau type
instToId (LitInst u list ty orig loc)
= TcId (mkInstId u ty (mkSysLocalName u SLIT("lit") loc))
\end{code}
......@@ -358,35 +366,35 @@ relevant in error messages.
\begin{code}
instance Outputable (Inst s) where
ppr sty inst = ppr_inst sty ppNil (\ o l -> ppNil) inst
ppr sty inst = ppr_inst sty empty (\ o l -> empty) inst
pprInst sty hdr inst = ppr_inst sty hdr (\ o l -> pprOrigin hdr o l sty) inst
ppr_inst sty hdr ppr_orig (LitInst u lit ty orig loc)
= ppHang (ppr_orig orig loc)
4 (ppCat [case lit of
OverloadedIntegral i -> ppInteger i
OverloadedFractional f -> ppRational f,
ppPStr SLIT("at"),
= hang (ppr_orig orig loc)
4 (hsep [case lit of
OverloadedIntegral i -> integer i
OverloadedFractional f -> rational f,
ptext SLIT("at"),
ppr sty ty,
show_uniq sty u])
ppr_inst sty hdr ppr_orig (Dict u clas ty orig loc)
= ppHang (ppr_orig orig loc)
4 (ppCat [ppr sty clas, pprParendGenType sty ty, show_uniq sty u])
= hang (ppr_orig orig loc)
4 (hsep [ppr sty clas, pprParendGenType sty ty, show_uniq sty u])
ppr_inst sty hdr ppr_orig (Method u id tys rho orig loc)
= ppHang (ppr_orig orig loc)
4 (ppCat [ppr sty id, ppPStr SLIT("at"), interppSP sty tys, show_uniq sty u])
= hang (ppr_orig orig loc)
4 (hsep [ppr sty id, ptext SLIT("at"), interppSP sty tys, show_uniq sty u])
show_uniq PprDebug u = ppr PprDebug u
show_uniq sty u = ppNil
show_uniq sty u = empty
\end{code}
Printing in error messages
\begin{code}
noInstanceErr inst sty = ppHang (ppPStr SLIT("No instance for:")) 4 (ppr sty inst)
noInstanceErr inst sty = hang (ptext SLIT("No instance for:")) 4 (ppr sty inst)
\end{code}
%************************************************************************
......@@ -417,7 +425,7 @@ the dfun type.
\begin{code}
lookupInst :: Inst s
-> TcM s ([Inst s],
(TcIdOcc s, TcExpr s)) -- The new binding
TcDictBinds s) -- The new binding
-- Dictionaries
......@@ -441,16 +449,15 @@ lookupInst dict@(Dict _ clas ty orig loc)
let
rhs = mkHsDictApp (mkHsTyApp (HsVar (RealId dfun_id)) ty_args) dict_ids
in
returnTc (dicts, (instToId dict, rhs))
returnTc (dicts, VarMonoBind (instToId dict) rhs)
-- Methods
lookupInst inst@(Method _ id tys rho orig loc)
= newDictsAtLoc orig loc theta `thenNF_Tc` \ (dicts, dict_ids) ->
returnTc (dicts, (instToId inst, mkHsDictApp (mkHsTyApp (HsVar id) tys) dict_ids))
where
(theta,_) = splitRhoTy rho
= tcSplitRhoTy rho `thenNF_Tc` \ (theta, _) ->
newDictsAtLoc orig loc theta `thenNF_Tc` \ (dicts, dict_ids) ->
returnTc (dicts, VarMonoBind (instToId inst) (mkHsDictApp (mkHsTyApp (HsVar id) tys) dict_ids))
-- Literals
......@@ -459,13 +466,13 @@ lookupInst inst@(LitInst u (OverloadedIntegral i) ty orig loc)
= -- It's overloaded but small enough to fit into an Int
tcLookupGlobalValueByKey fromIntClassOpKey `thenNF_Tc` \ from_int ->
newMethodAtLoc orig loc from_int [ty] `thenNF_Tc` \ (method_inst, method_id) ->
returnTc ([method_inst], (instToId inst, HsApp (HsVar method_id) int_lit))
returnTc ([method_inst], VarMonoBind (instToId inst) (HsApp (HsVar method_id) int_lit))
| otherwise
= -- Alas, it is overloaded and a big literal!
tcLookupGlobalValueByKey fromIntegerClassOpKey `thenNF_Tc` \ from_integer ->
newMethodAtLoc orig loc from_integer [ty] `thenNF_Tc` \ (method_inst, method_id) ->
returnTc ([method_inst], (instToId inst, HsApp (HsVar method_id) (HsLitOut (HsInt i) integerTy)))
returnTc ([method_inst], VarMonoBind (instToId inst) (HsApp (HsVar method_id) (HsLitOut (HsInt i) integerTy)))
where
intprim_lit = HsLitOut (HsIntPrim i) intPrimTy
int_lit = HsApp (HsVar (RealId intDataCon)) intprim_lit
......@@ -480,7 +487,7 @@ lookupInst inst@(LitInst u (OverloadedFractional f) ty orig loc)
rational_lit = HsLitOut (HsFrac f) rational_ty
in
newMethodAtLoc orig loc from_rational [ty] `thenNF_Tc` \ (method_inst, method_id) ->
returnTc ([method_inst], (instToId inst, HsApp (HsVar method_id) rational_lit))
returnTc ([method_inst], VarMonoBind (instToId inst) (HsApp (HsVar method_id) rational_lit))
\end{code}
There is a second, simpler interface, when you want an instance of a
......@@ -502,8 +509,8 @@ lookupSimpleInst class_inst_env clas ty
(_, theta, _) = splitSigmaTy (idType dfun)
noSimpleInst clas ty sty
= ppSep [ppPStr SLIT("No instance for class"), ppQuote (ppr sty clas),
ppPStr SLIT("at type"), ppQuote (ppr sty ty)]
= sep [ptext SLIT("No instance for class"), ppr sty clas,
ptext SLIT("at type"), ppr sty ty]
\end{code}
......@@ -636,37 +643,32 @@ pprOrigin hdr orig locn
= addErrLoc locn hdr $ \ sty ->
case orig of
OccurrenceOf id ->
ppBesides [ppPStr SLIT("at a use of an overloaded identifier: `"),
ppr sty id, ppChar '\'']
hsep [ptext SLIT("at a use of an overloaded identifier:"), ppr sty id]
OccurrenceOfCon id ->
ppBesides [ppPStr SLIT("at a use of an overloaded constructor: `"),
ppr sty id, ppChar '\'']
hsep [ptext SLIT("at a use of an overloaded constructor:"), ppr sty id]
InstanceDeclOrigin ->
ppPStr SLIT("in an instance declaration")
ptext SLIT("in an instance declaration")
LiteralOrigin lit ->
ppCat [ppPStr SLIT("at an overloaded literal:"), ppr sty lit]
hsep [ptext SLIT("at an overloaded literal:"), ppr sty lit]
ArithSeqOrigin seq ->
ppCat [ppPStr SLIT("at an arithmetic sequence:"), ppr sty seq]
hsep [ptext SLIT("at an arithmetic sequence:"), ppr sty seq]
SignatureOrigin ->
ppPStr SLIT("in a type signature")
ptext SLIT("in a type signature")
DoOrigin ->
ppPStr SLIT("in a do statement")
ptext SLIT("in a do statement")
ClassDeclOrigin ->
ppPStr SLIT("in a class declaration")
ptext SLIT("in a class declaration")
InstanceSpecOrigin _ clas ty ->
ppBesides [ppStr "in a SPECIALIZE instance pragma; class \"",
ppr sty clas, ppStr "\" type: ", ppr sty ty]
hsep [text "in a SPECIALIZE instance pragma; class",
ppr sty clas, text "type:", ppr sty ty]
ValSpecOrigin name ->
ppBesides [ppPStr SLIT("in a SPECIALIZE user-pragma for `"),
ppr sty name, ppChar '\'']
hsep [ptext SLIT("in a SPECIALIZE user-pragma for"), ppr sty name]
CCallOrigin clabel Nothing{-ccall result-} ->
ppBesides [ppPStr SLIT("in the result of the _ccall_ to `"),
ppStr clabel, ppChar '\'']
hsep [ptext SLIT("in the result of the _ccall_ to"), text clabel]
CCallOrigin clabel (Just arg_expr) ->
ppBesides [ppPStr SLIT("in an argument in the _ccall_ to `"),
ppStr clabel, ppStr "', namely: ", ppr sty arg_expr]
hsep [ptext SLIT("in an argument in the _ccall_ to"), text clabel <> comma, text "namely:", ppr sty arg_expr]
LitLitOrigin s ->
ppBesides [ppPStr SLIT("in this ``literal-literal'': "), ppStr s]
hcat [ptext SLIT("in this ``literal-literal'': "), text s]
UnknownOrigin ->
ppPStr SLIT("in... oops -- I don't know where the overloading came from!")
ptext SLIT("in... oops -- I don't know where the overloading came from!")
\end{code}
ghc/compiler/typecheck/TcBinds.lhs
View file @ 995d6dbf
This diff is collapsed.
ghc/compiler/typecheck/TcClassDcl.lhs
View file @ 995d6dbf
......@@ -10,10 +10,11 @@ module TcClassDcl ( tcClassDecl1, tcClassDecls2 ) where
IMP_Ubiq()
import HsSyn ( HsDecl(..), ClassDecl(..), HsBinds(..), Bind(..), MonoBinds(..),
import HsSyn ( HsDecl(..), ClassDecl(..), HsBinds(..), MonoBinds(..),
Match(..), GRHSsAndBinds(..), GRHS(..), HsExpr(..),
DefaultDecl, TyDecl, InstDecl, IfaceSig, Fixity,
HsLit(..), OutPat(..), Sig(..), HsType(..), HsTyVar,
SYN_IE(RecFlag), nonRecursive, andMonoBinds,
Stmt, DoOrListComp, ArithSeqInfo, InPat, Fake )
import HsTypes ( getTyVarName )
import HsPragmas ( ClassPragmas(..) )
......@@ -27,7 +28,7 @@ import TcHsSyn ( TcIdOcc(..), SYN_IE(TcHsBinds), SYN_IE(TcMonoBinds), SYN_IE(Tc
import Inst ( Inst, InstOrigin(..), SYN_IE(LIE), emptyLIE, plusLIE, newDicts, newMethod )
import TcEnv ( tcLookupClass, tcLookupTyVar, tcLookupTyCon, newLocalIds, tcAddImportedIdInfo,
tcExtendGlobalTyVars )
import TcInstDcls ( processInstBinds )
import TcInstDcls ( tcMethodBind )
import TcKind ( unifyKind, TcKind )
import TcMonad
import TcMonoType ( tcHsType, tcContext )
......@@ -36,25 +37,31 @@ import TcType ( SYN_IE(TcType), SYN_IE(TcTyVar), tcInstType, tcInstSigTyVars, t
import Bag ( foldBag, unionManyBags )
import Class ( GenClass, GenClassOp, mkClass, mkClassOp, classBigSig,
classOps, classOpString, classOpLocalType,
classOpTagByOccName, SYN_IE(ClassOp)
classOps, classOpString, classOpLocalType, classDefaultMethodId,
classOpTagByOccName, SYN_IE(ClassOp), SYN_IE(Class)
)
import Id ( GenId, mkSuperDictSelId, mkMethodSelId,
mkDefaultMethodId, getIdUnfolding,
idType, SYN_IE(Id)
)
import Id ( GenId, mkSuperDictSelId, mkMethodSelId, mkDefaultMethodId, getIdUnfolding,
idType )
import CoreUnfold ( getUnfoldingTemplate )
import IdInfo
import Name ( Name, isLocallyDefined, moduleString, modAndOcc, nameString )
import Name ( Name, isLocallyDefined, moduleString,
modAndOcc, nameString, NamedThing(..) )
import Outputable
import PrelVals ( nO_DEFAULT_METHOD_ERROR_ID )
import PprStyle
import Pretty
import PprType ( GenType, GenTyVar, GenClassOp )
import PprType ( GenClass, GenType, GenTyVar, GenClassOp )
import SpecEnv ( SpecEnv )
import SrcLoc ( mkGeneratedSrcLoc )
import Type ( mkFunTy, mkTyVarTy, mkTyVarTys, mkDictTy,
mkForAllTy, mkSigmaTy, splitSigmaTy)
mkForAllTy, mkSigmaTy, splitSigmaTy, SYN_IE(Type)
)
import TysWiredIn ( stringTy )
import TyVar ( unitTyVarSet, GenTyVar )
import Unique ( Unique )
import TyVar ( unitTyVarSet, GenTyVar, SYN_IE(TyVar) )
import Unique ( Unique )
import UniqFM ( Uniquable(..) )
import Util
......@@ -299,18 +306,22 @@ tcClassDecl2 (ClassDecl context class_name
= classBigSig clas
-- The selector binds are already in the selector Id's unfoldings
sel_binds = SingleBind $ NonRecBind $ foldr AndMonoBinds EmptyMonoBinds $
[ CoreMonoBind (RealId sel_id) (getUnfoldingTemplate (getIdUnfolding sel_id))
sel_binds = [ CoreMonoBind (RealId sel_id) (getUnfoldingTemplate (getIdUnfolding sel_id))
| sel_id <- sc_sel_ids ++ op_sel_ids,
isLocallyDefined sel_id
]
final_sel_binds = MonoBind (andMonoBinds sel_binds) [] nonRecursive
in
-- Generate bindings for the default methods
tcInstSigTyVars [tyvar] `thenNF_Tc` \ ([clas_tyvar], _, _) ->
buildDefaultMethodBinds clas clas_tyvar defm_ids default_binds
`thenTc` \ (const_insts, meth_binds) ->
mapAndUnzipTc (buildDefaultMethodBind clas clas_tyvar default_binds)
(op_sel_ids `zip` [0..])
`thenTc` \ (const_insts_s, meth_binds) ->
returnTc (const_insts, sel_binds `ThenBinds` meth_binds)
returnTc (unionManyBags const_insts_s,
final_sel_binds `ThenBinds`
MonoBind (andMonoBinds meth_binds) [] nonRecursive)
\end{code}
%************************************************************************
......@@ -387,151 +398,54 @@ dfun.Foo.List
\end{verbatim}
\begin{code}
buildDefaultMethodBinds
buildDefaultMethodBind
:: Class
-> TcTyVar s
-> [Id]
-> RenamedMonoBinds
-> TcM s (LIE s, TcHsBinds s)
-> (Id, Int)
-> TcM s (LIE s, TcMonoBinds s)
buildDefaultMethodBinds clas clas_tyvar
default_method_ids default_binds
buildDefaultMethodBind clas clas_tyvar default_binds (sel_id, idx)
= newDicts origin [(clas,inst_ty)] `thenNF_Tc` \ (this_dict, [this_dict_id]) ->
mapAndUnzipNF_Tc mk_method default_method_ids `thenNF_Tc` \ (insts_s, local_defm_ids) ->
let
avail_insts = this_dict `plusLIE` unionManyBags insts_s -- Insts available
clas_tyvar_set = unitTyVarSet clas_tyvar
avail_insts = this_dict
defm_id = classDefaultMethodId clas idx
in
tcExtendGlobalTyVars clas_tyvar_set (
processInstBinds
clas
(makeClassDeclDefaultMethodRhs clas local_defm_ids)
avail_insts
local_defm_ids
default_binds
) `thenTc` \ (insts_needed, default_binds') ->
tcSimplifyAndCheck
clas_tyvar_set
avail_insts
insts_needed `thenTc` \ (const_lie, dict_binds) ->
let
defm_binds = AbsBinds
[clas_tyvar]
[this_dict_id]
(local_defm_ids `zip` map RealId default_method_ids)
dict_binds
(RecBind default_binds')
in
returnTc (const_lie, defm_binds)
where
inst_ty = mkTyVarTy clas_tyvar
mk_method defm_id = newMethod origin (RealId defm_id) [inst_ty]
origin = ClassDeclOrigin
\end{code}
====================
buildDefaultMethodBinds
:: Class
-> TcTyVar s
-> [Id]
-> RenamedMonoBinds
-> TcM s (LIE s, TcHsBinds s)
buildDefaultMethodBinds clas clas_tyvar
default_method_ids default_binds
= newDicts origin [(clas,inst_ty)] `thenNF_Tc` \ (this_dict, [this_dict_id]) ->
tcExtendGlobalTyVars clas_tyvar_set (
tcDefaultMethodBinds default_binds
)
tcDefaultMethodBinds default_meth_ids default_binds
where
go (AndMonoBinds b1 b2)
= go b1 `thenTc` \ (new_b1, lie1) ->
go b2 `thenTc` \ (new_b2, lie2) ->
returnTc (new_b1 `ThenBinds` new_b2, lie1 `plusLIE` lie2)
go EmptyMonoBinds = EmptyBinds
go mbind = processInstBinds1 clas clas_dict meth_ids mbind `thenTc` \ (tags
tcDefaultMethodBinds EmptyMonoBinds
processInstBinds
clas
(makeClassDeclDefaultMethodRhs clas local_defm_ids)
avail_insts
local_defm_ids
default_binds
) `thenTc` \ (insts_needed, default_binds') ->
let
mapAndUnzipNF_Tc mk_method default_method_ids `thenNF_Tc` \ (insts_s, local_defm_ids) ->
let
avail_insts = this_dict `plusLIE` unionManyBags insts_s -- Insts available
clas_tyvar_set = unitTyVarSet clas_tyvar
in
tcMethodBind noDefmExpr inst_ty default_binds (sel_id, idx)
) `thenTc` \ (defm_bind, insts_needed, (_, local_defm_id)) ->
-- CHECK THE CONTEXT OF THE DEFAULT-METHOD BINDS
tcSimplifyAndCheck
clas_tyvar_set
avail_insts
insts_needed `thenTc` \ (const_lie, dict_binds) ->
let
defm_binds = AbsBinds
[clas_tyvar]
[this_dict_id]
(local_defm_ids `zip` map RealId default_method_ids)
dict_binds
(RecBind default_binds')
[([clas_tyvar], RealId defm_id, local_defm_id)]
(dict_binds `AndMonoBinds` defm_bind)
in
returnTc (const_lie, defm_binds)
where
inst_ty = mkTyVarTy clas_tyvar
mk_method defm_id = newMethod origin (RealId defm_id) [inst_ty]
origin = ClassDeclOrigin
==================
@makeClassDeclDefaultMethodRhs@ builds the default method for a
class declaration when no explicit default method is given.
\begin{code}
makeClassDeclDefaultMethodRhs
:: Class
-> [TcIdOcc s]
-> Int
-> NF_TcM s (TcExpr s)
makeClassDeclDefaultMethodRhs clas method_ids tag
= -- Return the expression
-- error ty "No default method for ..."
-- The interesting thing is that method_ty is a for-all type;
-- this is fun, although unusual in a type application!
returnNF_Tc (HsApp (mkHsTyApp (HsVar (RealId nO_DEFAULT_METHOD_ERROR_ID)) [tcIdType method_id])
(HsLitOut (HsString (_PK_ error_msg)) stringTy))
where
(clas_mod, clas_name) = modAndOcc clas
method_id = method_ids !! (tag-1)
class_op = (classOps clas) !! (tag-1)
error_msg = _UNPK_ (nameString (getName clas))
++ (ppShow 80 (ppr PprForUser class_op))
-- ++ "\"" Don't know what this trailing quote is for!
clas_tyvar_set = unitTyVarSet clas_tyvar
inst_ty = mkTyVarTy clas_tyvar
origin = ClassDeclOrigin
noDefmExpr _ = HsApp (HsVar (getName nO_DEFAULT_METHOD_ERROR_ID))
(HsLit (HsString (_PK_ error_msg)))
error_msg = show (sep [text "Class", ppr PprForUser clas,
text "Method", ppr PprForUser sel_id])
\end{code}
Contexts
~~~~~~~~
\begin{code}
classDeclCtxt class_name sty
= ppCat [ppPStr SLIT("In the class declaration for"), ppr sty class_name]
= hsep [ptext SLIT("In the class declaration for"), ppr sty class_name]
\end{code}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment