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 {-# 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 )
  42 #endif
  43
  44 \end{code}
  45
  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.
  50
  51 \begin{code}
  52 data PprEnv tyvar uvar bndr occ
  53   = PE  PprStyle                -- stored for safe keeping
  54
  55         (Literal    -> Doc)     -- Doing these this way saves
  56         (Id    -> Doc)  -- carrying around a PprStyle
  57         (PrimOp     -> Doc)
  58         (CostCentre -> Doc)
  59
  60         (tyvar -> Doc)  -- to print tyvar binders
  61         (tyvar -> Doc)  -- to print tyvar occurrences
  62
  63         (uvar -> Doc)   -- to print usage vars
  64
  65         (bndr -> Doc)   -- to print "major" val_bdrs
  66         (bndr -> Doc)   -- to print "minor" val_bdrs
  67         (occ  -> Doc)   -- to print bindees
  68
  69         (GenType tyvar uvar -> Doc)
  70         (GenUsage uvar -> Doc)
  71 \end{code}
  72
  73 \begin{code}
  74 initPprEnv
  75         :: PprStyle
  76         -> Maybe (Literal -> Doc)
  77         -> Maybe (Id -> 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)
  85         -> Maybe (occ -> Doc)
  86         -> Maybe (GenType tyvar uvar -> Doc)
  87         -> Maybe (GenUsage uvar -> Doc)
  88         -> PprEnv tyvar uvar bndr occ
  89
  90 -- you can specify all the printers individually; if
  91 -- you don't specify one, you get bottom
  92
  93 initPprEnv sty l d p c tvb tvo uv maj_bndr min_bndr occ ty use
  94   = PE sty
  95        (demaybe l)
  96        (demaybe d)
  97        (demaybe p)
  98        (demaybe c)
  99        (demaybe tvb)
 100        (demaybe tvo)
 101        (demaybe uv)
 102        (demaybe maj_bndr)
 103        (demaybe min_bndr)
 104        (demaybe occ)
 105        (demaybe ty)
 106        (demaybe use)
 107   where
 108     demaybe Nothing  = bottom
 109     demaybe (Just x) = x
 110
 111     bottom = panic "PprEnv.initPprEnv: unspecified printing function"
 112
 113 {-
 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
 119
 120         (ppr sty)   -- for a tyvar
 121         (ppr sty)   -- for a usage var
 122
 123         pmaj pmin pocc -- for GenIds in various guises
 124
 125         (ppr sty)   -- for a Type
 126         (ppr sty)   -- for a Usage
 127 -}
 128 \end{code}
 129
 130 \begin{code}
 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
 136
 137 pTyVarB  (PE _  _  _  _  _  pp _  _  _  _  _  _  _) = pp
 138 pTyVarO  (PE _  _  _  _  _  _  pp _  _  _  _  _  _) = pp
 139 pUVar    (PE _  _  _  _  _  _  _  pp _  _  _  _  _) = pp
 140
 141 pMajBndr (PE _  _  _  _  _  _  _  _ pp  _  _  _  _) = pp
 142 pMinBndr (PE _  _  _  _  _  _  _  _  _ pp  _  _  _) = pp
 143 pOcc     (PE _  _  _  _  _  _  _  _  _  _ pp  _  _) = pp
 144
 145 pTy      (PE _  _  _  _  _  _  _  _  _  _  _ pp  _) = pp
 146 pUse     (PE _  _  _  _  _  _  _  _  _  _  _  _ pp) = pp
 147 \end{code}
 148
 149 We tend to {\em renumber} everything before printing, so that
 150 we get consistent Uniques on everything from run to run.
 151 \begin{code}
 152 data NmbrEnv
 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
 159
 160 type NmbrM a = NmbrEnv -> (NmbrEnv, a)
 161
 162 initNmbr :: NmbrM a -> a
 163 initNmbr m
 164   = let
 165         (v1,t1,u1)    = initRenumberingUniques
 166         init_nmbr_env = NmbrEnv v1 t1 u1 emptyUFM emptyUFM emptyUFM
 167     in
 168     snd (m init_nmbr_env)
 169
 170 returnNmbr x nenv = (nenv, x)
 171
 172 thenNmbr m k nenv
 173   = let
 174         (nenv2, res) = m nenv
 175     in
 176     k res nenv2
 177
 178 mapNmbr f []     = returnNmbr []
 179 mapNmbr f (x:xs)
 180   = f x             `thenNmbr` \ r  ->
 181     mapNmbr f xs    `thenNmbr` \ rs ->
 182     returnNmbr (r:rs)
 183
 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)
 189
 190 {-
 191 nmbr1 nenv thing x1
 192   = let
 193         (nenv1, new_x1) = x1 nenv
 194     in
 195     (nenv1, thing new_x1)
 196
 197 nmbr2 nenv thing x1 x2
 198   = let
 199         (nenv1, new_x1) = x1 nenv
 200         (nenv2, new_x2) = x2 nenv1
 201     in
 202     (nenv2, thing new_x1 new_x2)
 203
 204 nmbr3 nenv thing x1 x2 x3
 205   = let
 206         (nenv1, new_x1) = x1 nenv
 207         (nenv2, new_x2) = x2 nenv1
 208         (nenv3, new_x3) = x3 nenv2
 209     in
 210     (nenv3, thing new_x1 new_x2 new_x3)
 211 -}
 212
 213 rnumValVar = panic "rnumValVar"
 214 rnumTyVar = panic "rnumTyVar"
 215 rnumUVar = panic "rnumUVar"
 216 lookupValVar = panic "lookupValVar"
 217 lookupTyVar = panic "lookupTyVar"
 218 lookupUVar = panic "lookupUVar"
 219 \end{code}