-\subsection{Core printing environment (purely local)}
-%* *
-%************************************************************************
-
-Similar to @VE@ in @PprType@. The ``values'' we print here
-are locally-defined nested-scope names; callers to @pprCoreBinding@,
-etc., can override these.
-
-For tyvars and uvars, we {\em do} normally use these homogenized
-names; for values, we {\em don't}. In printing interfaces, though,
-we use homogenized value names, so that interfaces don't wobble
-uncontrollably from changing Unique-based names.
-
-\begin{code}
-data PrintEnv tyvar uvar bndr occ
- = PE (Literal -> Pretty) -- Doing these this way saves
- (DataCon -> Pretty) -- carrying around a PprStyle
- (PrimOp -> Pretty)
- (CostCentre -> Pretty)
-
- [Pretty] -- Tyvar pretty names
- (tyvar -> Pretty) -- Tyvar lookup function
- [Pretty] -- Uvar pretty names
- (uvar -> Pretty) -- Uvar lookup function
-
- (GenType tyvar uvar -> Pretty)
- (GenUsage uvar -> Pretty)
-
- (ValPrinters bndr occ)
-
-data ValPrinters bndr occ
- = BOPE -- print binders/occs differently
- (bndr -> Pretty) -- to print "major" val_bdrs
- (bndr -> Pretty) -- to print "minor" val_bdrs
- (occ -> Pretty) -- to print bindees
-
- | VPE -- print all values the same way
- [Pretty] -- Value pretty names
- (bndr -> Pretty) -- Binder lookup function
- (occ -> Pretty) -- Occurrence lookup function
-\end{code}
-
-\begin{code}
-initial_pe :: (Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar,
- Outputable bndr, Outputable occ)
- => PprStyle
- -> Either
- (bndr -> Pretty, bndr -> Pretty, occ -> Pretty)
- ()
- -> PrintEnv tyvar uvar bndr occ
-
-initial_pe sty val_printing
- = PE (ppr sty) -- for a Literal
- (ppr sty) -- for a DataCon
- (ppr sty) -- for a PrimOp
- (\ cc -> ppStr (showCostCentre sty True cc)) -- CostCentre
-
- tv_pretties ppr_tv -- for a TyVar
- uv_pretties ppr_uv -- for a UsageVar
-
- (\ ty -> pprType_Internal sty tv_pretties ppr_tv uv_pretties ppr_uv ty)
- (ppr sty) -- for a Usage
-
- val_printing_stuff
- where
- ppr_tv = ppr sty -- to print a tyvar
- ppr_uv = ppr sty -- to print a uvar
-
- tv_pretties = map (\ c -> ppChar c ) ['a' .. 'h']
- ++
- map (\ n -> ppBeside (ppChar 'a') (ppInt n))
- ([0 .. ] :: [Int]) -- a0 ... aN
-
- uv_pretties = map (\ c -> ppChar c ) ['u' .. 'y']
- ++
- map (\ n -> ppBeside (ppChar 'u') (ppInt n))
- ([0 .. ] :: [Int]) -- u0 ... uN
-
- val_pretties = map (\ c -> ppChar c ) ['i' .. 'k']
- ++ map (\ n -> ppBeside (ppChar 'v') (ppInt n))
- ([0 .. ] :: [Int]) -- v0 ... vN
-
- ------------------------
- val_printing_stuff
- = case val_printing of
- Left (pbdr1, pbdr2, pocc) -> BOPE pbdr1 pbdr2 pocc
- Right () -> VPE val_pretties (ppr sty) (ppr sty)
-
-\end{code}
-
-\begin{code}
-plit (PE pp _ _ _ _ _ _ _ _ _ _) = pp
-pcon (PE _ pp _ _ _ _ _ _ _ _ _) = pp
-pprim (PE _ _ pp _ _ _ _ _ _ _ _) = pp
-pscc (PE _ _ _ pp _ _ _ _ _ _ _) = pp
-ptyvar (PE _ _ _ _ _ pp _ _ _ _ _) = pp
-puvar (PE _ _ _ _ _ _ _ pp _ _ _) = pp
-
-pty (PE _ _ _ _ _ _ _ _ pp _ _) = pp
-puse (PE _ _ _ _ _ _ _ _ _ pp _) = pp
-
-pmaj_bdr (PE _ _ _ _ _ _ _ _ _ _ (BOPE pp _ _)) = pp
-pmaj_bdr (PE _ _ _ _ _ _ _ _ _ _ (VPE _ pp _)) = pp
-
-pmin_bdr (PE _ _ _ _ _ _ _ _ _ _ (BOPE _ pp _)) = pp
-pmin_bdr (PE _ _ _ _ _ _ _ _ _ _ (VPE _ pp _)) = pp
-
-pocc (PE _ _ _ _ _ _ _ _ _ _ (BOPE _ _ pp)) = pp
-pocc (PE _ _ _ _ _ _ _ _ _ _ (VPE _ _ pp)) = pp
-\end{code}
-
-%************************************************************************
-%* *