[project @ 2000-01-24 18:22:07 by sewardj]

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

diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 9995ca3..9901853 100644 (file)
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -46,7 +46,7 @@ import OccName                ( OccName, pprOccName )
 import TyCon           ( TyCon, getSynTyConDefn, isSynTyCon, isNewTyCon, isAlgTyCon,
                          tyConTheta, tyConTyVars, tyConDataCons
                        )
-import Class           ( Class, classBigSig )
+import Class           ( Class, classExtraBigSig )
 import FieldLabel      ( fieldLabelName, fieldLabelType )
 import Type            ( mkSigmaTy, splitSigmaTy, mkDictTy, tidyTopType, deNoteType,
                          Type, ThetaType
@@ -54,6 +54,7 @@ import Type           ( mkSigmaTy, splitSigmaTy, mkDictTy, tidyTopType, deNoteType,
 
 import PprType
 import PprCore         ( pprIfaceUnfolding, pprCoreRule )
+import FunDeps         ( pprFundeps )
 import Rules           ( pprProtoCoreRule, ProtoCoreRule(..) )
 
 import Bag             ( bagToList, isEmptyBag )
@@ -90,7 +91,7 @@ endIface    :: Maybe Handle -> IO ()
 \end{code}
 
 \begin{code}
-startIface mod (has_orphans, import_usages, ExportEnv avails fixities)
+startIface mod (has_orphans, import_usages, ExportEnv avails fixities _)
   = case opt_ProduceHi of
       Nothing -> return Nothing ; -- not producing any .hi file
 
@@ -211,10 +212,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))
@@ -465,7 +466,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 && 
@@ -549,21 +550,22 @@ ifaceClass clas
           ppr_decl_context sc_theta,
           ppr clas,                    -- Print the name
           pprTyVarBndrs clas_tyvars,
+          pprFundeps clas_fds,
           pp_ops,
           semi
          ]
    where
-     (clas_tyvars, sc_theta, _, sel_ids, defms) = classBigSig clas
+     (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
 
-     pp_ops | null sel_ids  = empty
-           | otherwise = hsep [ptext SLIT("where"),
-                                braces (hsep (punctuate semi (zipWith ppr_classop sel_ids defms)))
-                         ]
+     pp_ops | null op_stuff  = empty
+           | otherwise      = hsep [ptext SLIT("where"),
+                                    braces (hsep (punctuate semi (map ppr_classop op_stuff)))
+                              ]
 
-     ppr_classop sel_id maybe_defm
+     ppr_classop (sel_id, dm_id, explicit_dm)
        = ASSERT( sel_tyvars == clas_tyvars)
          hsep [ppr (getOccName sel_id),
-               if maybeToBool maybe_defm then equals else empty,
+               if explicit_dm then equals else empty,
                dcolon,
                ppr op_ty
          ]