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