diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-09-02 19:42:01 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-09-17 20:04:08 -0400 |
| commit | ca48076ae866665913b9c81cbc0c76f0afef7a00 (patch) | |
| tree | 52ad46e313b99fc564bd77de2efeb0bfb8babb47 /compiler/GHC/StgToCmm/Layout.hs | |
| parent | 9dec8600ad4734607bea2b4dc3b40a5af788996b (diff) | |
| download | haskell-ca48076ae866665913b9c81cbc0c76f0afef7a00.tar.gz | |
Introduce OutputableP
Some types need a Platform value to be pretty-printed: CLabel, Cmm
types, instructions, etc.
Before this patch they had an Outputable instance and the Platform value
was obtained via sdocWithDynFlags. It meant that the *renderer* of the
SDoc was responsible of passing the appropriate Platform value (e.g. via
the DynFlags given to showSDoc). It put the burden of passing the
Platform value on the renderer while the generator of the SDoc knows the
Platform it is generating the SDoc for and there is no point passing a
different Platform at rendering time.
With this patch, we introduce a new OutputableP class:
class OutputableP a where
pdoc :: Platform -> a -> SDoc
With this class we still have some polymorphism as we have with `ppr`
(i.e. we can use `pdoc` on a variety of types instead of having a
dedicated `pprXXX` function for each XXX type).
One step closer removing `sdocWithDynFlags` (#10143) and supporting
several platforms (#14335).
Diffstat (limited to 'compiler/GHC/StgToCmm/Layout.hs')
| -rw-r--r-- | compiler/GHC/StgToCmm/Layout.hs | 7 |
1 files changed, 4 insertions, 3 deletions
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs index 89175caf93..70a9fc8fe7 100644 --- a/compiler/GHC/StgToCmm/Layout.hs +++ b/compiler/GHC/StgToCmm/Layout.hs @@ -204,7 +204,7 @@ slowCall fun stg_args r <- direct_call "slow_call" NativeNodeCall (mkRtsApFastLabel rts_fun) arity ((P,Just fun):argsreps) emitComment $ mkFastString ("slow_call for " ++ - showSDoc dflags (ppr fun) ++ + showSDoc dflags (pdoc platform fun) ++ " with pat " ++ unpackFS rts_fun) return r @@ -291,10 +291,11 @@ direct_call :: String direct_call caller call_conv lbl arity args | debugIsOn && args `lengthLessThan` real_arity -- Too few args = do -- Caller should ensure that there enough args! + platform <- getPlatform pprPanic "direct_call" $ text caller <+> ppr arity <+> - ppr lbl <+> ppr (length args) <+> - ppr (map snd args) <+> ppr (map fst args) + pdoc platform lbl <+> ppr (length args) <+> + pdoc platform (map snd args) <+> ppr (map fst args) | null rest_args -- Precisely the right number of arguments = emitCall (call_conv, NativeReturn) target (nonVArgs args) |