X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsBinds.lhs;h=c0f01a86108040e9cb4ad85e200d54a17474e8b3;hp=6c2f8f3928f021caf7aca79e7e66f89a3cab5c01;hb=a8427a4125e9b78e88a487eeabf018f1c6e8bc08;hpb=490791568ac1b31fed0d049892e0853c774aa375 diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 6c2f8f3..c0f01a8 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -17,7 +17,7 @@ import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr, LHsExpr, import {-# SOURCE #-} HsPat ( LPat ) import HsTypes -import PprCore +import PprCore () import Coercion import Type import Name @@ -52,7 +52,9 @@ data HsValBinds id -- Value bindings (not implicit parameters) -- Recursive by default | ValBindsOut -- After renaming - [(RecFlag, LHsBinds id)] -- Dependency analysed + [(RecFlag, LHsBinds id)] -- Dependency analysed, later bindings + -- in the list may depend on earlier + -- ones. [LSig Name] type LHsBinds id = Bag (LHsBind id) @@ -93,7 +95,7 @@ data HsBind id -- Before renaming, and after typechecking, -- the field is unused; it's just an error thunk - fun_tick :: Maybe Int -- This is the (optional) module-local tick number. + fun_tick :: Maybe (Int,[id]) -- This is the (optional) module-local tick number. } | PatBind { -- The pattern is never a simple variable; @@ -163,7 +165,7 @@ instance OutputableBndr id => Outputable (HsValBinds id) where pprValBindsForUser :: (OutputableBndr id1, OutputableBndr id2) => LHsBinds id1 -> [LSig id2] -> SDoc pprValBindsForUser binds sigs - = vcat (map snd (sort_by_loc decls)) + = pprDeeperList vcat (map snd (sort_by_loc decls)) where decls :: [(SrcSpan, SDoc)] @@ -175,7 +177,7 @@ pprValBindsForUser binds sigs pprLHsBinds :: OutputableBndr id => LHsBinds id -> SDoc pprLHsBinds binds | isEmptyLHsBinds binds = empty - | otherwise = lbrace <+> vcat (map ppr (bagToList binds)) <+> rbrace + | otherwise = lbrace <+> pprDeeperList vcat (map ppr (bagToList binds)) <+> rbrace ------------ emptyLocalBinds :: HsLocalBinds a @@ -240,14 +242,13 @@ ppr_monobind :: OutputableBndr id => HsBind id -> SDoc ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss }) = pprPatBind pat grhss ppr_monobind (VarBind { var_id = var, var_rhs = rhs }) = ppr var <+> equals <+> pprExpr (unLoc rhs) -ppr_monobind (FunBind { fun_id = fun, +ppr_monobind (FunBind { fun_id = fun, fun_infix = inf, fun_matches = matches, fun_tick = tick }) = (case tick of Nothing -> empty Just t -> text "-- tick id = " <> ppr t - ) $$ pprFunBind (unLoc fun) matches - -- ToDo: print infix if appropriate + ) $$ pprFunBind (unLoc fun) inf matches ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_dicts = dictvars, abs_exports = exports, abs_binds = val_binds }) @@ -290,7 +291,7 @@ data IPBind id (LHsExpr id) instance (OutputableBndr id) => Outputable (HsIPBinds id) where - ppr (IPBinds bs ds) = vcat (map ppr bs) + ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs) $$ pprLHsBinds ds instance (OutputableBndr id) => Outputable (IPBind id) where @@ -317,10 +318,10 @@ data HsWrapper | WpCo Coercion -- A cast: [] `cast` co -- Guaranteedn not the identity coercion - | WpApp Var -- [] x; the xi are dicts or coercions - | WpTyApp Type -- [] t - | WpLam Id -- \x. []; the xi are dicts or coercions - | WpTyLam TyVar -- \a. [] + | WpApp Var -- [] d the 'd' is a type-class dictionary + | WpTyApp Type -- [] t the 't' is a type or corecion + | WpLam Id -- \d. [] the 'd' is a type-class dictionary + | WpTyLam TyVar -- \a. [] the 'a' is a type or coercion variable -- Non-empty bindings, so that the identity coercion -- is always exactly WpHole @@ -544,3 +545,4 @@ pprPrag :: Outputable id => id -> LPrag -> SDoc pprPrag var (L _ (InlinePrag inl)) = ppr inl <+> ppr var pprPrag var (L _ (SpecPrag expr ty _ inl)) = pprSpec var ty inl \end{code} +