Commit 8f674b1c authored by simonpj's avatar simonpj

[project @ 2000-04-20 16:31:47 by simonpj]

Finish TcClassDecl
parent c5b20ebe
......@@ -242,7 +242,7 @@ tcClassContext class_name rec_class rec_tyvars context sc_sel_names
let
sc_theta' = classesOfPreds sc_theta
sc_tys = mkDictTys sc_theta'
sc_sel_ids = zipWithEqual "tcClassContext" mk_super_id sc_sel_names sc_tys
sc_sel_ids = [mkDictSelId sc_name rec_class | sc_name <- sc_sel_names]
in
-- Done
returnTc (sc_theta', sc_tys, sc_sel_ids)
......@@ -250,14 +250,8 @@ tcClassContext class_name rec_class rec_tyvars context sc_sel_names
where
rec_tyvar_tys = mkTyVarTys rec_tyvars
mk_super_id name dict_ty
= mkDictSelId name rec_class {- SUP:??? ty
where
ty = mkForAllTys rec_tyvars $
mkFunTy (mkDictTy rec_class rec_tyvar_tys) dict_ty -}
check_constraint (HsPClass c tys) = checkTc (all is_tyvar tys)
(superClassErr class_name (c, tys))
(superClassErr class_name (c, tys))
is_tyvar (MonoTyVar _) = True
is_tyvar other = False
......@@ -289,7 +283,7 @@ tcClassSig rec_env rec_clas rec_clas_tyvars
local_ty
-- Build the selector id and default method id
sel_id = mkDictSelId op_name rec_clas {- SUP:??? global_ty -}
sel_id = mkDictSelId op_name rec_clas
dm_id = mkDefaultMethodId dm_name rec_clas global_ty
final_dm_id = tcAddImportedIdInfo rec_env dm_id
in
......
Markdown is supported
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