tcExtendLocalValEnv
)
import TcBinds ( tcBindWithSigs, tcSpecSigs )
+import TcTyDecls ( mkNewTyConRep )
import TcUnify ( unifyKinds )
import TcMonad
import TcMonoType ( kcHsType, tcHsTopType, tcExtendTopTyVarScope,
import NameSet ( emptyNameSet )
import Outputable
import Type ( Type, ThetaType, ClassContext,
- mkFunTy, mkTyVarTy, mkTyVarTys, mkDictTy,
+ mkFunTy, mkTyVarTy, mkTyVarTys, mkDictTy, mkDictTys,
mkSigmaTy, mkForAllTys, mkClassPred, classesOfPreds,
boxedTypeKind, mkArrowKind
)
-import PprType ( {- instance Outputable Type -} )
import Var ( tyVarKind, TyVar )
import VarSet ( mkVarSet, emptyVarSet )
-import TyCon ( mkAlgTyCon )
+import TyCon ( AlgTyConFlavour(..), mkClassTyCon )
import Unique ( Unique, Uniquable(..) )
import Util
import Maybes ( seqMaybe )
dict_component_tys = sc_tys ++ op_tys
new_or_data = case dict_component_tys of
- [_] -> NewType
- other -> DataType
+ [_] -> NewTyCon (mkNewTyConRep tycon)
+ other -> DataTyCon
dict_con = mkDataCon datacon_name
[notMarkedStrict | _ <- dict_component_tys]
ppr tycon_name)
tycon_name
- tycon = mkAlgTyCon tycon_name
- class_kind
- tyvars
- [] -- No context
- argvrcs
- [dict_con] -- Constructors
- [] -- No derivings
- (Just clas) -- Yes! It's a dictionary
- new_or_data
- NonRecursive
+ tycon = mkClassTyCon tycon_name
+ class_kind
+ tyvars
+ argvrcs
+ dict_con -- Constructors
+ clas -- Yes! It's a dictionary
+ new_or_data
in
returnTc clas
\end{code}
let
sc_theta' = classesOfPreds sc_theta
- sc_tys = [mkDictTy sc tys | (sc,tys) <- sc_theta']
+ sc_tys = mkDictTys sc_theta'
sc_sel_ids = zipWithEqual "tcClassContext" mk_super_id sc_sel_names sc_tys
in
-- Done
rec_tyvar_tys = mkTyVarTys rec_tyvars
mk_super_id name dict_ty
- = mkDictSelId name rec_class ty
+ = mkDictSelId name rec_class {- SUP:??? ty
where
ty = mkForAllTys rec_tyvars $
- mkFunTy (mkDictTy rec_class rec_tyvar_tys) dict_ty
+ mkFunTy (mkDictTy rec_class rec_tyvar_tys) dict_ty -}
check_constraint (HsPClass c tys) = checkTc (all is_tyvar tys)
(superClassErr class_name (c, tys))
local_ty
-- Build the selector id and default method id
- sel_id = mkDictSelId op_name rec_clas global_ty
+ sel_id = mkDictSelId op_name rec_clas {- SUP:??? global_ty -}
dm_id = mkDefaultMethodId dm_name rec_clas global_ty
final_dm_id = tcAddImportedIdInfo rec_env dm_id
in