ghc/compiler/hsSyn/HsTypes.lhs

   1 ]%
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[HsTypes]{Abstract syntax: user-defined types}
   5
   6 \begin{code}
   7 module HsTypes (
   8           HsType(..), HsTyVarBndr(..),
   9         , HsContext, HsPred(..)
  10
  11         , mkHsForAllTy, mkHsDictTy, mkHsIParamTy
  12         , hsTyVarName, hsTyVarNames, replaceTyVarName
  13         , splitHsInstDeclTy
  14
  15         -- Type place holder
  16         , PostTcType, placeHolderType,
  17
  18         -- Name place holder
  19         , SyntaxName, placeHolderName,
  20
  21         -- Printing
  22         , pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
  23     ) where
  24
  25 #include "HsVersions.h"
  26
  27 import TcType           ( Type, Kind, liftedTypeKind, eqKind )
  28 import TypeRep          ( Type )
  29 import Name             ( Name, mkInternalName )
  30 import OccName          ( mkVarOcc )
  31 import PprType          ( {- instance Outputable Kind -}, pprParendKind, pprKind )
  32 import BasicTypes       ( IPName, Boxity, tupleParens )
  33 import PrelNames        ( unboundKey )
  34 import SrcLoc           ( noSrcLoc )
  35 import Outputable
  36 \end{code}
  37
  38
  39 %************************************************************************
  40 %*                                                                      *
  41 \subsection{Annotating the syntax}
  42 %*                                                                      *
  43 %************************************************************************
  44
  45 \begin{code}
  46 type PostTcType = Type          -- Used for slots in the abstract syntax
  47                                 -- where we want to keep slot for a type
  48                                 -- to be added by the type checker...but
  49                                 -- before typechecking it's just bogus
  50
  51 placeHolderType :: PostTcType   -- Used before typechecking
  52 placeHolderType  = panic "Evaluated the place holder for a PostTcType"
  53
  54
  55 type SyntaxName = Name          -- These names are filled in by the renamer
  56                                 -- Before then they are a placeHolderName (so that
  57                                 --      we can still print the HsSyn)
  58                                 -- They correspond to "rebindable syntax";
  59                                 -- See RnEnv.lookupSyntaxName
  60
  61 placeHolderName :: SyntaxName
  62 placeHolderName = mkInternalName unboundKey
  63                         (mkVarOcc FSLIT("syntaxPlaceHolder"))
  64                         noSrcLoc
  65 \end{code}
  66
  67
  68 %************************************************************************
  69 %*                                                                      *
  70 \subsection{Data types}
  71 %*                                                                      *
  72 %************************************************************************
  73
  74 This is the syntax for types as seen in type signatures.
  75
  76 \begin{code}
  77 type HsContext name = [HsPred name]
  78
  79 data HsPred name = HsClassP name [HsType name]
  80                  | HsIParam (IPName name) (HsType name)
  81
  82 data HsType name
  83   = HsForAllTy  (Maybe [HsTyVarBndr name])      -- Nothing for implicitly quantified signatures
  84                 (HsContext name)
  85                 (HsType name)
  86
  87   | HsTyVar             name            -- Type variable or type constructor
  88
  89   | HsAppTy             (HsType name)
  90                         (HsType name)
  91
  92   | HsFunTy             (HsType name)   -- function type
  93                         (HsType name)
  94
  95   | HsListTy            (HsType name)   -- Element type
  96
  97   | HsPArrTy            (HsType name)   -- Elem. type of parallel array: [:t:]
  98
  99   | HsTupleTy           Boxity
 100                         [HsType name]   -- Element types (length gives arity)
 101
 102   | HsOpTy              (HsType name) name (HsType name)
 103
 104   | HsParTy             (HsType name)
 105         -- Parenthesis preserved for the precedence re-arrangement in RnTypes
 106         -- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
 107         --
 108         -- However, NB that toHsType doesn't add HsParTys (in an effort to keep
 109         -- interface files smaller), so when printing a HsType we may need to
 110         -- add parens.
 111
 112   | HsNumTy             Integer         -- Generics only
 113
 114   -- these next two are only used in interfaces
 115   | HsPredTy            (HsPred name)
 116
 117   | HsKindSig           (HsType name)   -- (ty :: kind)
 118                         Kind            -- A type with a kind signature
 119
 120
 121 -----------------------
 122 -- Combine adjacent for-alls.
 123 -- The following awkward situation can happen otherwise:
 124 --      f :: forall a. ((Num a) => Int)
 125 -- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
 126 -- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
 127 -- but the export list abstracts f wrt [a].  Disaster.
 128 --
 129 -- A valid type must have one for-all at the top of the type, or of the fn arg types
 130
 131 mkHsForAllTy mtvs []   ty = mk_forall_ty mtvs ty
 132 mkHsForAllTy mtvs ctxt ty = HsForAllTy mtvs ctxt ty
 133
 134 -- mk_forall_ty makes a pure for-all type (no context)
 135 mk_forall_ty (Just []) ty                         = ty  -- Explicit for-all with no tyvars
 136 mk_forall_ty mtvs1     (HsParTy ty)               = mk_forall_ty mtvs1 ty
 137 mk_forall_ty mtvs1     (HsForAllTy mtvs2 ctxt ty) = mkHsForAllTy (mtvs1 `plus` mtvs2) ctxt ty
 138 mk_forall_ty mtvs1     ty                         = HsForAllTy mtvs1 [] ty
 139
 140 mtvs1       `plus` Nothing     = mtvs1
 141 Nothing     `plus` mtvs2       = mtvs2
 142 (Just tvs1) `plus` (Just tvs2) = Just (tvs1 ++ tvs2)
 143
 144 mkHsDictTy cls tys = HsPredTy (HsClassP cls tys)
 145 mkHsIParamTy v ty  = HsPredTy (HsIParam v ty)
 146
 147 data HsTyVarBndr name
 148   = UserTyVar name
 149   | KindedTyVar name Kind
 150         -- *** NOTA BENE *** A "monotype" in a pragma can have
 151         -- for-alls in it, (mostly to do with dictionaries).  These
 152         -- must be explicitly Kinded.
 153
 154 hsTyVarName (UserTyVar n)     = n
 155 hsTyVarName (KindedTyVar n _) = n
 156
 157 hsTyVarNames tvs = map hsTyVarName tvs
 158
 159 replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
 160 replaceTyVarName (UserTyVar n)     n' = UserTyVar n'
 161 replaceTyVarName (KindedTyVar n k) n' = KindedTyVar n' k
 162 \end{code}
 163
 164
 165 \begin{code}
 166 splitHsInstDeclTy
 167     :: Outputable name
 168     => HsType name
 169     -> ([HsTyVarBndr name], HsContext name, name, [HsType name])
 170         -- Split up an instance decl type, returning the pieces
 171
 172 -- In interface files, the instance declaration head is created
 173 -- by HsTypes.toHsType, which does not guarantee to produce a
 174 -- HsForAllTy.  For example, if we had the weird decl
 175 --      instance Foo T => Foo [T]
 176 -- then we'd get the instance type
 177 --      Foo T -> Foo [T]
 178 -- So when colleting the instance context, to be on the safe side
 179 -- we gather predicate arguments
 180 --
 181 -- For source code, the parser ensures the type will have the right shape.
 182 -- (e.g. see ParseUtil.checkInstType)
 183
 184 splitHsInstDeclTy inst_ty
 185   = case inst_ty of
 186         HsForAllTy (Just tvs) cxt1 tau
 187               -> (tvs, cxt1++cxt2, cls, tys)
 188               where
 189                  (cxt2, cls, tys) = split_tau tau
 190
 191         other -> ([],  cxt2,  cls, tys)
 192               where
 193                  (cxt2, cls, tys) = split_tau inst_ty
 194
 195   where
 196     split_tau (HsFunTy (HsPredTy p) ty) = (p:ps, cls, tys)
 197                                         where
 198                                           (ps, cls, tys) = split_tau ty
 199     split_tau (HsPredTy (HsClassP cls tys)) = ([], cls,tys)
 200     split_tau other = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
 201 \end{code}
 202
 203
 204 %************************************************************************
 205 %*                                                                      *
 206 \subsection{Pretty printing}
 207 %*                                                                      *
 208 %************************************************************************
 209
 210 NB: these types get printed into interface files, so
 211     don't change the printing format lightly
 212
 213 \begin{code}
 214 instance (Outputable name) => Outputable (HsType name) where
 215     ppr ty = pprHsType ty
 216
 217 instance (Outputable name) => Outputable (HsTyVarBndr name) where
 218     ppr (UserTyVar name)        = ppr name
 219     ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
 220
 221 instance Outputable name => Outputable (HsPred name) where
 222     ppr (HsClassP clas tys) = ppr clas <+> hsep (map pprParendHsType tys)
 223     ppr (HsIParam n ty)    = hsep [ppr n, dcolon, ppr ty]
 224
 225 pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
 226 pprHsTyVarBndr name kind | kind `eqKind` liftedTypeKind = ppr name
 227                          | otherwise                    = hsep [ppr name, dcolon, pprParendKind kind]
 228
 229 pprHsForAll []  []  = empty
 230 pprHsForAll tvs cxt
 231         -- This printer is used for both interface files and
 232         -- printing user types in error messages; and alas the
 233         -- two use slightly different syntax.  Ah well.
 234   = getPprStyle $ \ sty ->
 235     if userStyle sty then
 236         ptext SLIT("forall") <+> interppSP tvs <> dot <+>
 237               -- **! ToDo: want to hide uvars from user, but not enough info
 238               -- in a HsTyVarBndr name (see PprType).  KSW 2000-10.
 239         pprHsContext cxt
 240     else        -- Used in interfaces
 241         ptext SLIT("__forall") <+> interppSP tvs <+>
 242         ppr_hs_context cxt <+> ptext SLIT("=>")
 243
 244 pprHsContext :: (Outputable name) => HsContext name -> SDoc
 245 pprHsContext []  = empty
 246 pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
 247
 248 ppr_hs_context []  = empty
 249 ppr_hs_context cxt = parens (interpp'SP cxt)
 250 \end{code}
 251
 252 \begin{code}
 253 pREC_TOP = (0 :: Int)  -- type   in ParseIface.y
 254 pREC_FUN = (1 :: Int)  -- btype  in ParseIface.y
 255                         -- Used for LH arg of (->)
 256 pREC_OP  = (2 :: Int)   -- Used for arg of any infix operator
 257                         -- (we don't keep their fixities around)
 258 pREC_CON = (3 :: Int)   -- Used for arg of type applicn:
 259                         -- always parenthesise unless atomic
 260
 261 maybeParen :: Int       -- Precedence of context
 262            -> Int       -- Precedence of top-level operator
 263            -> SDoc -> SDoc      -- Wrap in parens if (ctxt >= op)
 264 maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
 265                                | otherwise            = p
 266
 267 -- printing works more-or-less as for Types
 268
 269 pprHsType, pprParendHsType :: (Outputable name) => HsType name -> SDoc
 270
 271 pprHsType ty       = ppr_mono_ty pREC_TOP (de_paren ty)
 272 pprParendHsType ty = ppr_mono_ty pREC_CON ty
 273
 274 -- Remove outermost HsParTy parens before printing a type
 275 de_paren (HsParTy ty) = de_paren ty
 276 de_paren ty           = ty
 277
 278 ppr_mono_ty ctxt_prec (HsForAllTy maybe_tvs ctxt ty)
 279   = maybeParen ctxt_prec pREC_FUN $
 280     sep [pp_header, pprHsType ty]
 281   where
 282     pp_header = case maybe_tvs of
 283                   Just tvs -> pprHsForAll tvs ctxt
 284                   Nothing  -> pprHsContext ctxt
 285
 286 ppr_mono_ty ctxt_prec (HsTyVar name)      = ppr name
 287 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   = ppr_fun_ty ctxt_prec ty1 ty2
 288 ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
 289 ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_ty pREC_TOP ty <+> dcolon <+> pprKind kind)
 290 ppr_mono_ty ctxt_prec (HsListTy ty)       = brackets (ppr_mono_ty pREC_TOP ty)
 291 ppr_mono_ty ctxt_prec (HsPArrTy ty)       = pabrackets (ppr_mono_ty pREC_TOP ty)
 292 ppr_mono_ty ctxt_prec (HsPredTy pred)     = braces (ppr pred)
 293 ppr_mono_ty ctxt_prec (HsNumTy n)         = integer n  -- generics only
 294
 295 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
 296   = maybeParen ctxt_prec pREC_CON $
 297     hsep [ppr_mono_ty pREC_FUN fun_ty, ppr_mono_ty pREC_CON arg_ty]
 298
 299 ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
 300   = maybeParen ctxt_prec pREC_OP $
 301     ppr_mono_ty pREC_OP ty1 <+> ppr op <+> ppr_mono_ty pREC_OP ty2
 302
 303 ppr_mono_ty ctxt_prec (HsParTy ty)
 304   = parens (ppr_mono_ty pREC_TOP ty)
 305   -- Put the parens in where the user did
 306   -- But we still use the precedence stuff to add parens because
 307   --    toHsType doesn't put in any HsParTys, so we may still need them
 308
 309 --------------------------
 310 ppr_fun_ty ctxt_prec ty1 ty2
 311   = let p1 = ppr_mono_ty pREC_FUN ty1
 312         p2 = ppr_mono_ty pREC_TOP ty2
 313     in
 314     maybeParen ctxt_prec pREC_FUN $
 315     sep [p1, ptext SLIT("->") <+> p2]
 316
 317 --------------------------
 318 pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
 319 \end{code}
 320
 321