ghc/compiler/basicTypes/PprEnv.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996
   3 %
   4 \section[PprEnv]{The @PprEnv@ type}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module PprEnv (
  10         PprEnv{-abstract-},
  11
  12         initPprEnv,
  13
  14         pCon, pLit, pMajBndr, pMinBndr, pOcc, pPrim, pSCC, pStyle,
  15         pTy, pTyVarB, pTyVarO, pUVar, pUse,
  16
  17         NmbrEnv(..),
  18         SYN_IE(NmbrM), initNmbr,
  19         returnNmbr, thenNmbr,
  20         mapNmbr, mapAndUnzipNmbr
  21 --      nmbr1, nmbr2, nmbr3
  22 --      rnumValVar,   rnumTyVar,   rnumUVar,
  23 --      lookupValVar, lookupTyVar, lookupUVar
  24     ) where
  25
  26 IMP_Ubiq(){-uitous-}
  27
  28 import Pretty           ( Doc )
  29 import Outputable
  30 import Unique           ( initRenumberingUniques, Unique )
  31 import UniqFM           ( emptyUFM, UniqFM )
  32 import Util             ( panic )
  33 #if __GLASGOW_HASKELL__ >= 202
  34 IMPORT_DELOOPER(TyLoop)
  35 import Outputable       ( PprStyle )
  36 import Literal          ( Literal )
  37 import Usage            ( GenUsage, SYN_IE(Usage) )
  38 import {-# SOURCE #-}   PrimOp (PrimOp)
  39 import {-# SOURCE #-}   CostCentre ( CostCentre )
  40 #endif
  41
  42 \end{code}
  43
  44 For tyvars and uvars, we {\em do} normally use these homogenized
  45 names; for values, we {\em don't}.  In printing interfaces, though,
  46 we use homogenized value names, so that interfaces don't wobble
  47 uncontrollably from changing Unique-based names.
  48
  49 \begin{code}
  50 data PprEnv tyvar uvar bndr occ
  51   = PE  PprStyle                -- stored for safe keeping
  52
  53         (Literal    -> Doc)     -- Doing these this way saves
  54         (Id    -> Doc)  -- carrying around a PprStyle
  55         (PrimOp     -> Doc)
  56         (CostCentre -> Doc)
  57
  58         (tyvar -> Doc)  -- to print tyvar binders
  59         (tyvar -> Doc)  -- to print tyvar occurrences
  60
  61         (uvar -> Doc)   -- to print usage vars
  62
  63         (bndr -> Doc)   -- to print "major" val_bdrs
  64         (bndr -> Doc)   -- to print "minor" val_bdrs
  65         (occ  -> Doc)   -- to print bindees
  66
  67         (GenType tyvar uvar -> Doc)
  68         (GenUsage uvar -> Doc)
  69 \end{code}
  70
  71 \begin{code}
  72 initPprEnv
  73         :: PprStyle
  74         -> Maybe (Literal -> Doc)
  75         -> Maybe (Id -> Doc)
  76         -> Maybe (PrimOp  -> Doc)
  77         -> Maybe (CostCentre -> Doc)
  78         -> Maybe (tyvar -> Doc)
  79         -> Maybe (tyvar -> Doc)
  80         -> Maybe (uvar -> Doc)
  81         -> Maybe (bndr -> Doc)
  82         -> Maybe (bndr -> Doc)
  83         -> Maybe (occ -> Doc)
  84         -> Maybe (GenType tyvar uvar -> Doc)
  85         -> Maybe (GenUsage uvar -> Doc)
  86         -> PprEnv tyvar uvar bndr occ
  87
  88 -- you can specify all the printers individually; if
  89 -- you don't specify one, you get bottom
  90
  91 initPprEnv sty l d p c tvb tvo uv maj_bndr min_bndr occ ty use
  92   = PE sty
  93        (demaybe l)
  94        (demaybe d)
  95        (demaybe p)
  96        (demaybe c)
  97        (demaybe tvb)
  98        (demaybe tvo)
  99        (demaybe uv)
 100        (demaybe maj_bndr)
 101        (demaybe min_bndr)
 102        (demaybe occ)
 103        (demaybe ty)
 104        (demaybe use)
 105   where
 106     demaybe Nothing  = bottom
 107     demaybe (Just x) = x
 108
 109     bottom = panic "PprEnv.initPprEnv: unspecified printing function"
 110
 111 {-
 112 initPprEnv sty pmaj pmin pocc
 113   = PE  (ppr sty)   -- for a Literal
 114         (ppr sty)   -- for a DataCon
 115         (ppr sty)   -- for a PrimOp
 116         (\ cc -> text (showCostCentre sty True cc)) -- CostCentre
 117
 118         (ppr sty)   -- for a tyvar
 119         (ppr sty)   -- for a usage var
 120
 121         pmaj pmin pocc -- for GenIds in various guises
 122
 123         (ppr sty)   -- for a Type
 124         (ppr sty)   -- for a Usage
 125 -}
 126 \end{code}
 127
 128 \begin{code}
 129 pStyle   (PE s  _  _  _  _  _  _  _  _  _  _  _  _) = s
 130 pLit     (PE _ pp  _  _  _  _  _  _  _  _  _  _  _) = pp
 131 pCon     (PE _  _ pp  _  _  _  _  _  _  _  _  _  _) = pp
 132 pPrim    (PE _  _  _ pp  _  _  _  _  _  _  _  _  _) = pp
 133 pSCC     (PE _  _  _  _ pp  _  _  _  _  _  _  _  _) = pp
 134
 135 pTyVarB  (PE _  _  _  _  _  pp _  _  _  _  _  _  _) = pp
 136 pTyVarO  (PE _  _  _  _  _  _  pp _  _  _  _  _  _) = pp
 137 pUVar    (PE _  _  _  _  _  _  _  pp _  _  _  _  _) = pp
 138
 139 pMajBndr (PE _  _  _  _  _  _  _  _ pp  _  _  _  _) = pp
 140 pMinBndr (PE _  _  _  _  _  _  _  _  _ pp  _  _  _) = pp
 141 pOcc     (PE _  _  _  _  _  _  _  _  _  _ pp  _  _) = pp
 142
 143 pTy      (PE _  _  _  _  _  _  _  _  _  _  _ pp  _) = pp
 144 pUse     (PE _  _  _  _  _  _  _  _  _  _  _  _ pp) = pp
 145 \end{code}
 146
 147 We tend to {\em renumber} everything before printing, so that
 148 we get consistent Uniques on everything from run to run.
 149 \begin{code}
 150 data NmbrEnv
 151   = NmbrEnv     Unique  -- next "Unique" to give out for a value
 152                 Unique  -- ... for a tyvar
 153                 Unique  -- ... for a usage var
 154                 (UniqFM Id)     -- mapping for value vars we know about
 155                 (UniqFM TyVar)  -- ... for tyvars
 156                 (UniqFM Unique{-UVar-}) -- ... for usage vars
 157
 158 type NmbrM a = NmbrEnv -> (NmbrEnv, a)
 159
 160 initNmbr :: NmbrM a -> a
 161 initNmbr m
 162   = let
 163         (v1,t1,u1)    = initRenumberingUniques
 164         init_nmbr_env = NmbrEnv v1 t1 u1 emptyUFM emptyUFM emptyUFM
 165     in
 166     snd (m init_nmbr_env)
 167
 168 returnNmbr x nenv = (nenv, x)
 169
 170 thenNmbr m k nenv
 171   = let
 172         (nenv2, res) = m nenv
 173     in
 174     k res nenv2
 175
 176 mapNmbr f []     = returnNmbr []
 177 mapNmbr f (x:xs)
 178   = f x             `thenNmbr` \ r  ->
 179     mapNmbr f xs    `thenNmbr` \ rs ->
 180     returnNmbr (r:rs)
 181
 182 mapAndUnzipNmbr f [] = returnNmbr ([],[])
 183 mapAndUnzipNmbr f (x:xs)
 184   = f x                     `thenNmbr` \ (r1,  r2)  ->
 185     mapAndUnzipNmbr f xs    `thenNmbr` \ (rs1, rs2) ->
 186     returnNmbr (r1:rs1, r2:rs2)
 187
 188 {-
 189 nmbr1 nenv thing x1
 190   = let
 191         (nenv1, new_x1) = x1 nenv
 192     in
 193     (nenv1, thing new_x1)
 194
 195 nmbr2 nenv thing x1 x2
 196   = let
 197         (nenv1, new_x1) = x1 nenv
 198         (nenv2, new_x2) = x2 nenv1
 199     in
 200     (nenv2, thing new_x1 new_x2)
 201
 202 nmbr3 nenv thing x1 x2 x3
 203   = let
 204         (nenv1, new_x1) = x1 nenv
 205         (nenv2, new_x2) = x2 nenv1
 206         (nenv3, new_x3) = x3 nenv2
 207     in
 208     (nenv3, thing new_x1 new_x2 new_x3)
 209 -}
 210
 211 rnumValVar = panic "rnumValVar"
 212 rnumTyVar = panic "rnumTyVar"
 213 rnumUVar = panic "rnumUVar"
 214 lookupValVar = panic "lookupValVar"
 215 lookupTyVar = panic "lookupTyVar"
 216 lookupUVar = panic "lookupUVar"
 217 \end{code}