[project @ 2000-02-20 17:51:30 by panne]

[ghc-hetmet.git] / ghc / compiler / main / MkIface.lhs

diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 224e31e..4167f47 100644 (file)
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -48,8 +48,9 @@ import TyCon          ( TyCon, getSynTyConDefn, isSynTyCon, isNewTyCon, isAlgTyCon,
                        )
 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
@@ -91,7 +92,7 @@ endIface    :: Maybe Handle -> IO ()
 \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
 
@@ -212,10 +213,10 @@ ifaceRules if_hdl rules emitted
        
        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))
@@ -260,7 +261,8 @@ ifaceInstances if_hdl inst_infos
                --      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, 
@@ -466,7 +468,7 @@ ifaceBinds hdl needed_ids final_ids binds
 %************************************************************************
 
 \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 && 
@@ -494,7 +496,7 @@ ifaceTyCon tycon
 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("="),
@@ -528,7 +530,7 @@ ifaceTyCon tycon
 
     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
 
@@ -547,7 +549,7 @@ ifaceTyCon tycon
 
 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,
@@ -576,9 +578,23 @@ ppr_decl_context :: ThetaType -> SDoc
 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}
 
 %************************************************************************