)
import Class ( Class, classExtraBigSig )
import FieldLabel ( fieldLabelName, fieldLabelType )
-import Type ( mkSigmaTy, splitSigmaTy, mkDictTy, tidyTopType, deNoteType,
- Type, ThetaType
+import Type ( mkSigmaTy, splitSigmaTy, mkDictTy, tidyTopType,
+ deNoteType, classesToPreds,
+ Type, ThetaType, PredType(..), ClassContext
)
import PprType
\end{code}
\begin{code}
-startIface mod (has_orphans, import_usages, ExportEnv avails fixities)
+startIface mod (InterfaceDetails has_orphans import_usages (ExportEnv avails fixities _) _)
= case opt_ProduceHi of
Nothing -> return Nothing ; -- not producing any .hi file
return ()
where
- orphan_rule_pretties = [ pprCoreRule (Just fn) rule <+> semi
+ orphan_rule_pretties = [ pprCoreRule (Just fn) rule
| ProtoCoreRule _ fn rule <- rules
]
- local_id_pretties = [ pprCoreRule (Just fn) rule <+> semi
+ local_id_pretties = [ pprCoreRule (Just fn) rule
| fn <- varSetElems emitted,
rule <- rulesRules (getIdSpecialisation fn),
all (`elemVarSet` emitted) (varSetElems (ruleSomeLhsFreeVars interestingId rule))
-- instance Foo Tibble where ...
-- and this instance decl wouldn't get imported into a module
-- that mentioned T but not Tibble.
- forall_ty = mkSigmaTy tvs theta (deNoteType (mkDictTy clas tys))
+ forall_ty = mkSigmaTy tvs (classesToPreds theta)
+ (deNoteType (mkDictTy clas tys))
renumbered_ty = tidyTopType forall_ty
in
hcat [ptext SLIT("instance "), pprType renumbered_ty,
%************************************************************************
\begin{code}
-ifaceTyCons hdl tycons = hPutCol hdl upp_tycon (sortLt (<) (filter (for_iface_name . getName) tycons ))
+ifaceTyCons hdl tycons = hPutCol hdl upp_tycon (sortLt (<) (filter (for_iface_name . getName) tycons))
ifaceClasses hdl classes = hPutCol hdl upp_class (sortLt (<) (filter (for_iface_name . getName) classes))
for_iface_name name = isLocallyDefined name &&
ifaceTyCon tycon
| isAlgTyCon tycon
= hsep [ ptext keyword,
- ppr_decl_context (tyConTheta tycon),
+ ppr_decl_class_context (tyConTheta tycon),
ppr (getName tycon),
pprTyVarBndrs (tyConTyVars tycon),
ptext SLIT("="),
ppr_ex [] ex_theta = ASSERT( null ex_theta ) empty
ppr_ex ex_tvs ex_theta = ptext SLIT("__forall") <+> brackets (pprTyVarBndrs ex_tvs)
- <+> pprIfaceTheta ex_theta <+> ptext SLIT("=>")
+ <+> pprIfaceClasses ex_theta <+> ptext SLIT("=>")
ppr_arg_ty (strict_mark, ty) = ppr_strict_mark strict_mark <> pprParendType ty
ifaceClass clas
= hsep [ptext SLIT("class"),
- ppr_decl_context sc_theta,
+ ppr_decl_class_context sc_theta,
ppr clas, -- Print the name
pprTyVarBndrs clas_tyvars,
pprFundeps clas_fds,
ppr_decl_context [] = empty
ppr_decl_context theta = pprIfaceTheta theta <+> ptext SLIT(" =>")
+ppr_decl_class_context :: ClassContext -> SDoc
+ppr_decl_class_context [] = empty
+ppr_decl_class_context ctxt = pprIfaceClasses ctxt <+> ptext SLIT(" =>")
+
pprIfaceTheta :: ThetaType -> SDoc -- Use braces rather than parens in interface files
pprIfaceTheta [] = empty
-pprIfaceTheta theta = braces (hsep (punctuate comma [pprConstraint c tys | (c,tys) <- theta]))
+pprIfaceTheta theta = braces (hsep (punctuate comma [pprIfacePred p | p <- theta]))
+
+-- ZZ - not sure who uses this - i.e. whether IParams really show up or not
+-- (it's not used to print normal value signatures)
+pprIfacePred :: PredType -> SDoc
+pprIfacePred (Class clas tys) = pprConstraint clas tys
+pprIfacePred (IParam n ty) = char '?' <> ppr n <+> ptext SLIT("::") <+> ppr ty
+
+pprIfaceClasses :: ClassContext -> SDoc
+pprIfaceClasses [] = empty
+pprIfaceClasses theta = braces (hsep (punctuate comma [pprConstraint c tys | (c,tys) <- theta]))
\end{code}
%************************************************************************