From 13b6fa58cf5441d2b928949805368015770d8d17 Mon Sep 17 00:00:00 2001 From: sof Date: Sun, 18 May 1997 22:54:16 +0000 Subject: [PATCH] [project @ 1997-05-18 22:54:16 by sof] new PP;2.0x bootable --- ghc/compiler/typecheck/TcDeriv.lhs | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs index d9f0b62..3bdb454 100644 --- a/ghc/compiler/typecheck/TcDeriv.lhs +++ b/ghc/compiler/typecheck/TcDeriv.lhs @@ -13,7 +13,7 @@ module TcDeriv ( tcDeriving ) where IMP_Ubiq() import HsSyn ( HsDecl, FixityDecl, Fixity, InstDecl, - Sig, HsBinds(..), Bind(..), MonoBinds(..), + Sig, HsBinds(..), MonoBinds(..), GRHSsAndBinds, Match, HsExpr, HsLit, InPat, ArithSeqInfo, Fake, HsType, collectMonoBinders @@ -38,19 +38,19 @@ import RnMonad ( SYN_IE(RnM), RnDown, GDown, SDown, RnNameSupply(..), setNameSupplyRn, renameSourceCode, thenRn, mapRn, returnRn ) import Bag ( Bag, isEmptyBag, unionBags, listToBag ) -import Class ( classKey, GenClass ) +import Class ( classKey, GenClass, SYN_IE(Class) ) import ErrUtils ( pprBagOfErrors, addErrLoc, SYN_IE(Error) ) import Id ( dataConArgTys, isNullaryDataCon, mkDictFunId ) import PrelInfo ( needsDataDeclCtxtClassKeys ) import Maybes ( maybeToBool ) import Name ( isLocallyDefined, getSrcLoc, ExportFlag(..), Provenance, - Name{--O only-} + Name{--O only-}, SYN_IE(Module) ) import Outputable ( Outputable(..){-instances e.g., (,)-} ) import PprType ( GenType, GenTyVar, GenClass, TyCon ) import PprStyle ( PprStyle(..) ) -import Pretty ( ppAbove, ppAboves, ppCat, ppBesides, - ppPStr, ppStr, ppChar, ppHang, SYN_IE(Pretty) ) +import Pretty ( ($$), vcat, hsep, hcat, + ptext, text, char, hang, Doc ) --import Pretty--ToDo:rm --import FiniteMap--ToDo:rm import SrcLoc ( mkGeneratedSrcLoc, SrcLoc ) @@ -63,13 +63,14 @@ import Type ( GenType(..), SYN_IE(TauType), mkTyVarTys, applyTyCon, getAppDataTyCon, getAppTyCon ) import TysPrim ( voidTy ) -import TyVar ( GenTyVar ) +import TyVar ( GenTyVar, SYN_IE(TyVar) ) import UniqFM ( emptyUFM ) import Unique -- Keys stuff import Bag ( bagToList ) import Util ( zipWithEqual, zipEqual, sortLt, removeDups, assoc, thenCmp, cmpList, panic, panic#, pprPanic, pprPanic#, - assertPanic-- , pprTrace{-ToDo:rm-} + Ord3(..), assertPanic-- , pprTrace{-ToDo:rm-} + ) \end{code} @@ -205,7 +206,7 @@ tcDeriving :: Module -- name of module under scrutiny -> Bag InstInfo -- What we already know about instances -> TcM s (Bag InstInfo, -- The generated "instance decls". RenamedHsBinds, -- Extra generated bindings - PprStyle -> Pretty) -- Printable derived instance decls; + PprStyle -> Doc) -- Printable derived instance decls; -- for debugging via -ddump-derivings. tcDeriving modname rn_name_supply inst_decl_infos_in @@ -238,7 +239,7 @@ tcDeriving modname rn_name_supply inst_decl_infos_in -- method bindings for the instances. (dfun_names_w_method_binds, rn_extra_binds) = renameSourceCode modname rn_name_supply ( - bindLocatedLocalsRn "deriving" mbinders $ \ _ -> + bindLocatedLocalsRn (\_ -> text "deriving") mbinders $ \ _ -> rnTopMonoBinds extra_mbinds [] `thenRn` \ rn_extra_binds -> mapRn rn_one method_binds_s `thenRn` \ dfun_names_w_method_binds -> returnRn (dfun_names_w_method_binds, rn_extra_binds) @@ -259,13 +260,13 @@ tcDeriving modname rn_name_supply inst_decl_infos_in rn_extra_binds, ddump_deriv) where - ddump_deriving :: [InstInfo] -> RenamedHsBinds -> (PprStyle -> Pretty) + ddump_deriving :: [InstInfo] -> RenamedHsBinds -> (PprStyle -> Doc) ddump_deriving inst_infos extra_binds sty - = ppAboves ((map pp_info inst_infos) ++ [ppr sty extra_binds]) + = vcat ((map pp_info inst_infos) ++ [ppr sty extra_binds]) where pp_info (InstInfo clas tvs ty inst_decl_theta _ _ mbinds _ _) - = ppAbove (ppr sty (mkSigmaTy tvs inst_decl_theta (mkDictTy clas ty))) + = ($$) (ppr sty (mkSigmaTy tvs inst_decl_theta (mkDictTy clas ty))) (ppr sty mbinds) \end{code} @@ -469,7 +470,7 @@ solveDerivEqns inst_decl_infos_in orig_eqns = (tv1 `cmp` tv2) `thenCmp` (c1 `cmp` c2) #ifdef DEBUG cmp_rhs other_1 other_2 - = panic# "tcDeriv:cmp_rhs:" --(ppCat [ppr PprDebug other_1, ppr PprDebug other_2]) + = panic# "tcDeriv:cmp_rhs:" --(hsep [ppr PprDebug other_1, ppr PprDebug other_2]) #endif \end{code} @@ -517,7 +518,7 @@ add_solns inst_infos_in eqns solns -- We can't leave it as a panic because to get the theta part we -- have to run down the type! - my_panic str = panic "add_soln" -- pprPanic ("add_soln:"++str) (ppCat [ppChar ':', ppr PprDebug clas, ppr PprDebug tycon]) + my_panic str = panic "add_soln" -- pprPanic ("add_soln:"++str) (hsep [char ':', ppr PprDebug clas, ppr PprDebug tycon]) \end{code} %************************************************************************ @@ -669,7 +670,7 @@ gen_taggery_Names :: [InstInfo] TagThingWanted)] gen_taggery_Names inst_infos - = --pprTrace "gen_taggery:\n" (ppAboves [ppCat [ppr PprDebug c, ppr PprDebug t] | (c,t) <- all_CTs]) $ + = --pprTrace "gen_taggery:\n" (vcat [hsep [ppr PprDebug c, ppr PprDebug t] | (c,t) <- all_CTs]) $ foldlTc do_con2tag [] tycons_of_interest `thenTc` \ names_so_far -> foldlTc do_tag2con names_so_far tycons_of_interest where @@ -717,6 +718,6 @@ gen_taggery_Names inst_infos derivingThingErr :: String -> TyCon -> Error derivingThingErr thing tycon sty - = ppHang (ppCat [ppPStr SLIT("Can't make a derived instance of"), ppStr thing]) - 4 (ppBesides [ppPStr SLIT("for the type `"), ppr sty tycon, ppChar '\'']) + = hang (hsep [ptext SLIT("Can't make a derived instance of"), text thing]) + 4 (hsep [ptext SLIT("for the type"), ppr sty tycon]) \end{code} -- 1.7.10.4