2 % (c) The AQUA Project, Glasgow University, 1996
4 \section[PprEnv]{The @PprEnv@ type}
7 #include "HsVersions.h"
14 pCon, pLit, pMajBndr, pMinBndr, pOcc, pPrim, pSCC, pStyle,
15 pTy, pTyVarB, pTyVarO, pUVar, pUse,
18 SYN_IE(NmbrM), initNmbr,
20 mapNmbr, mapAndUnzipNmbr
21 -- nmbr1, nmbr2, nmbr3
22 -- rnumValVar, rnumTyVar, rnumUVar,
23 -- lookupValVar, lookupTyVar, lookupUVar
30 import Unique ( initRenumberingUniques, Unique )
31 import UniqFM ( emptyUFM, UniqFM )
33 #if __GLASGOW_HASKELL__ >= 202
34 import {-# SOURCE #-} Type ( GenType )
35 import {-# SOURCE #-} TyVar ( TyVar )
36 import {-# SOURCE #-} Id ( Id )
37 import Outputable ( PprStyle )
38 import Literal ( Literal )
39 import Usage ( GenUsage, SYN_IE(Usage) )
40 import {-# SOURCE #-} PrimOp (PrimOp)
41 import {-# SOURCE #-} CostCentre ( CostCentre )
46 For tyvars and uvars, we {\em do} normally use these homogenized
47 names; for values, we {\em don't}. In printing interfaces, though,
48 we use homogenized value names, so that interfaces don't wobble
49 uncontrollably from changing Unique-based names.
52 data PprEnv tyvar uvar bndr occ
53 = PE PprStyle -- stored for safe keeping
55 (Literal -> Doc) -- Doing these this way saves
56 (Id -> Doc) -- carrying around a PprStyle
60 (tyvar -> Doc) -- to print tyvar binders
61 (tyvar -> Doc) -- to print tyvar occurrences
63 (uvar -> Doc) -- to print usage vars
65 (bndr -> Doc) -- to print "major" val_bdrs
66 (bndr -> Doc) -- to print "minor" val_bdrs
67 (occ -> Doc) -- to print bindees
69 (GenType tyvar uvar -> Doc)
70 (GenUsage uvar -> Doc)
76 -> Maybe (Literal -> Doc)
78 -> Maybe (PrimOp -> Doc)
79 -> Maybe (CostCentre -> Doc)
80 -> Maybe (tyvar -> Doc)
81 -> Maybe (tyvar -> Doc)
82 -> Maybe (uvar -> Doc)
83 -> Maybe (bndr -> Doc)
84 -> Maybe (bndr -> Doc)
86 -> Maybe (GenType tyvar uvar -> Doc)
87 -> Maybe (GenUsage uvar -> Doc)
88 -> PprEnv tyvar uvar bndr occ
90 -- you can specify all the printers individually; if
91 -- you don't specify one, you get bottom
93 initPprEnv sty l d p c tvb tvo uv maj_bndr min_bndr occ ty use
108 demaybe Nothing = bottom
111 bottom = panic "PprEnv.initPprEnv: unspecified printing function"
114 initPprEnv sty pmaj pmin pocc
115 = PE (ppr sty) -- for a Literal
116 (ppr sty) -- for a DataCon
117 (ppr sty) -- for a PrimOp
118 (\ cc -> text (showCostCentre sty True cc)) -- CostCentre
120 (ppr sty) -- for a tyvar
121 (ppr sty) -- for a usage var
123 pmaj pmin pocc -- for GenIds in various guises
125 (ppr sty) -- for a Type
126 (ppr sty) -- for a Usage
131 pStyle (PE s _ _ _ _ _ _ _ _ _ _ _ _) = s
132 pLit (PE _ pp _ _ _ _ _ _ _ _ _ _ _) = pp
133 pCon (PE _ _ pp _ _ _ _ _ _ _ _ _ _) = pp
134 pPrim (PE _ _ _ pp _ _ _ _ _ _ _ _ _) = pp
135 pSCC (PE _ _ _ _ pp _ _ _ _ _ _ _ _) = pp
137 pTyVarB (PE _ _ _ _ _ pp _ _ _ _ _ _ _) = pp
138 pTyVarO (PE _ _ _ _ _ _ pp _ _ _ _ _ _) = pp
139 pUVar (PE _ _ _ _ _ _ _ pp _ _ _ _ _) = pp
141 pMajBndr (PE _ _ _ _ _ _ _ _ pp _ _ _ _) = pp
142 pMinBndr (PE _ _ _ _ _ _ _ _ _ pp _ _ _) = pp
143 pOcc (PE _ _ _ _ _ _ _ _ _ _ pp _ _) = pp
145 pTy (PE _ _ _ _ _ _ _ _ _ _ _ pp _) = pp
146 pUse (PE _ _ _ _ _ _ _ _ _ _ _ _ pp) = pp
149 We tend to {\em renumber} everything before printing, so that
150 we get consistent Uniques on everything from run to run.
153 = NmbrEnv Unique -- next "Unique" to give out for a value
154 Unique -- ... for a tyvar
155 Unique -- ... for a usage var
156 (UniqFM Id) -- mapping for value vars we know about
157 (UniqFM TyVar) -- ... for tyvars
158 (UniqFM Unique{-UVar-}) -- ... for usage vars
160 type NmbrM a = NmbrEnv -> (NmbrEnv, a)
162 initNmbr :: NmbrM a -> a
165 (v1,t1,u1) = initRenumberingUniques
166 init_nmbr_env = NmbrEnv v1 t1 u1 emptyUFM emptyUFM emptyUFM
168 snd (m init_nmbr_env)
170 returnNmbr x nenv = (nenv, x)
174 (nenv2, res) = m nenv
178 mapNmbr f [] = returnNmbr []
180 = f x `thenNmbr` \ r ->
181 mapNmbr f xs `thenNmbr` \ rs ->
184 mapAndUnzipNmbr f [] = returnNmbr ([],[])
185 mapAndUnzipNmbr f (x:xs)
186 = f x `thenNmbr` \ (r1, r2) ->
187 mapAndUnzipNmbr f xs `thenNmbr` \ (rs1, rs2) ->
188 returnNmbr (r1:rs1, r2:rs2)
193 (nenv1, new_x1) = x1 nenv
195 (nenv1, thing new_x1)
197 nmbr2 nenv thing x1 x2
199 (nenv1, new_x1) = x1 nenv
200 (nenv2, new_x2) = x2 nenv1
202 (nenv2, thing new_x1 new_x2)
204 nmbr3 nenv thing x1 x2 x3
206 (nenv1, new_x1) = x1 nenv
207 (nenv2, new_x2) = x2 nenv1
208 (nenv3, new_x3) = x3 nenv2
210 (nenv3, thing new_x1 new_x2 new_x3)
213 rnumValVar = panic "rnumValVar"
214 rnumTyVar = panic "rnumTyVar"
215 rnumUVar = panic "rnumUVar"
216 lookupValVar = panic "lookupValVar"
217 lookupTyVar = panic "lookupTyVar"
218 lookupUVar = panic "lookupUVar"