compiler/parser/RdrHsSyn.lhs

   1 %
   2 % (c) The University of Glasgow, 1996-2003
   3
   4 Functions over HsSyn specialised to RdrName.
   5
   6 \begin{code}
   7 module RdrHsSyn (
   8         extractHsTyRdrTyVars,
   9         extractHsRhoRdrTyVars, extractGenericPatTyVars,
  10
  11         mkHsOpApp, mkClassDecl,
  12         mkHsNegApp, mkHsIntegral, mkHsFractional,
  13         mkHsDo, mkHsSplice,
  14         mkTyData, mkPrefixCon, mkRecCon, mkInlineSpec,
  15         mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
  16
  17         cvBindGroup,
  18         cvBindsAndSigs,
  19         cvTopDecls,
  20         findSplice, mkGroup,
  21
  22         -- Stuff to do with Foreign declarations
  23         CallConv(..),
  24         mkImport,            -- CallConv -> Safety
  25                               -- -> (FastString, RdrName, RdrNameHsType)
  26                               -- -> P RdrNameHsDecl
  27         mkExport,            -- CallConv
  28                               -- -> (FastString, RdrName, RdrNameHsType)
  29                               -- -> P RdrNameHsDecl
  30         mkExtName,           -- RdrName -> CLabelString
  31         mkGadtDecl,          -- Located RdrName -> LHsType RdrName -> ConDecl RdrName
  32
  33         -- Bunch of functions in the parser monad for
  34         -- checking and constructing values
  35         checkPrecP,           -- Int -> P Int
  36         checkContext,         -- HsType -> P HsContext
  37         checkPred,            -- HsType -> P HsPred
  38         checkTyClHdr,         -- LHsContext RdrName -> LHsType RdrName -> P (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName], [LHsType RdrName])
  39         checkTyVars,          -- [LHsType RdrName] -> Bool -> P ()
  40         checkSynHdr,          -- LHsType RdrName -> P (Located RdrName, [LHsTyVarBndr RdrName], Maybe [LHsType RdrName])
  41         checkKindSigs,        -- [LTyClDecl RdrName] -> P ()
  42         checkTopTypeD,        -- LTyClDecl RdrName -> P (HsDecl RdrName)
  43         checkInstType,        -- HsType -> P HsType
  44         checkPattern,         -- HsExp -> P HsPat
  45         checkPatterns,        -- SrcLoc -> [HsExp] -> P [HsPat]
  46         checkDo,              -- [Stmt] -> P [Stmt]
  47         checkMDo,             -- [Stmt] -> P [Stmt]
  48         checkValDef,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
  49         checkValSig,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
  50         parseError,           -- String -> Pa
  51     ) where
  52
  53 #include "HsVersions.h"
  54
  55 import HsSyn            -- Lots of it
  56 import RdrName          ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc,
  57                           isRdrDataCon, isUnqual, getRdrName, isQual,
  58                           setRdrNameSpace )
  59 import BasicTypes       ( maxPrecedence, Activation, InlineSpec(..), alwaysInlineSpec, neverInlineSpec )
  60 import Lexer            ( P, failSpanMsgP, extension, bangPatEnabled )
  61 import TysWiredIn       ( unitTyCon )
  62 import ForeignCall      ( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
  63                           DNCallSpec(..), DNKind(..), CLabelString )
  64 import OccName          ( srcDataName, varName, isDataOcc, isTcOcc,
  65                           occNameString )
  66 import SrcLoc
  67 import OrdList          ( OrdList, fromOL )
  68 import Bag              ( Bag, emptyBag, snocBag, consBag, foldrBag )
  69 import Outputable
  70 import FastString
  71 import Panic
  72
  73 import List             ( isSuffixOf, nubBy )
  74 \end{code}
  75
  76
  77 %************************************************************************
  78 %*                                                                      *
  79 \subsection{A few functions over HsSyn at RdrName}
  80 %*                                                                    *
  81 %************************************************************************
  82
  83 extractHsTyRdrNames finds the free variables of a HsType
  84 It's used when making the for-alls explicit.
  85
  86 \begin{code}
  87 extractHsTyRdrTyVars :: LHsType RdrName -> [Located RdrName]
  88 extractHsTyRdrTyVars ty = nubBy eqLocated (extract_lty ty [])
  89
  90 extractHsRhoRdrTyVars :: LHsContext RdrName -> LHsType RdrName -> [Located RdrName]
  91 -- This one takes the context and tau-part of a
  92 -- sigma type and returns their free type variables
  93 extractHsRhoRdrTyVars ctxt ty
  94  = nubBy eqLocated $ extract_lctxt ctxt (extract_lty ty [])
  95
  96 extract_lctxt ctxt acc = foldr (extract_pred . unLoc) acc (unLoc ctxt)
  97
  98 extract_pred (HsClassP cls tys) acc     = foldr extract_lty acc tys
  99 extract_pred (HsIParam n ty) acc        = extract_lty ty acc
 100
 101 extract_lty (L loc ty) acc
 102   = case ty of
 103       HsTyVar tv                -> extract_tv loc tv acc
 104       HsBangTy _ ty             -> extract_lty ty acc
 105       HsAppTy ty1 ty2           -> extract_lty ty1 (extract_lty ty2 acc)
 106       HsListTy ty               -> extract_lty ty acc
 107       HsPArrTy ty               -> extract_lty ty acc
 108       HsTupleTy _ tys           -> foldr extract_lty acc tys
 109       HsFunTy ty1 ty2           -> extract_lty ty1 (extract_lty ty2 acc)
 110       HsPredTy p                -> extract_pred p acc
 111       HsOpTy ty1 (L loc tv) ty2 -> extract_tv loc tv (extract_lty ty1 (extract_lty ty2 acc))
 112       HsParTy ty                -> extract_lty ty acc
 113       HsNumTy num               -> acc
 114       HsSpliceTy _              -> acc  -- Type splices mention no type variables
 115       HsKindSig ty k            -> extract_lty ty acc
 116       HsForAllTy exp [] cx ty   -> extract_lctxt cx (extract_lty ty acc)
 117       HsForAllTy exp tvs cx ty  -> acc ++ (filter ((`notElem` locals) . unLoc) $
 118                                            extract_lctxt cx (extract_lty ty []))
 119                                 where
 120                                    locals = hsLTyVarNames tvs
 121
 122 extract_tv :: SrcSpan -> RdrName -> [Located RdrName] -> [Located RdrName]
 123 extract_tv loc tv acc | isRdrTyVar tv = L loc tv : acc
 124                       | otherwise     = acc
 125
 126 extractGenericPatTyVars :: LHsBinds RdrName -> [Located RdrName]
 127 -- Get the type variables out of the type patterns in a bunch of
 128 -- possibly-generic bindings in a class declaration
 129 extractGenericPatTyVars binds
 130   = nubBy eqLocated (foldrBag get [] binds)
 131   where
 132     get (L _ (FunBind { fun_matches = MatchGroup ms _ })) acc = foldr (get_m.unLoc) acc ms
 133     get other                                             acc = acc
 134
 135     get_m (Match (L _ (TypePat ty) : _) _ _) acc = extract_lty ty acc
 136     get_m other                                    acc = acc
 137 \end{code}
 138
 139
 140 %************************************************************************
 141 %*                                                                      *
 142 \subsection{Construction functions for Rdr stuff}
 143 %*                                                                    *
 144 %************************************************************************
 145
 146 mkClassDecl builds a RdrClassDecl, filling in the names for tycon and datacon
 147 by deriving them from the name of the class.  We fill in the names for the
 148 tycon and datacon corresponding to the class, by deriving them from the
 149 name of the class itself.  This saves recording the names in the interface
 150 file (which would be equally good).
 151
 152 Similarly for mkConDecl, mkClassOpSig and default-method names.
 153
 154         *** See "THE NAMING STORY" in HsDecls ****
 155
 156 \begin{code}
 157 mkClassDecl (cxt, cname, tyvars) fds sigs mbinds ats
 158   = ClassDecl { tcdCtxt = cxt, tcdLName = cname, tcdTyVars = tyvars,
 159                 tcdFDs = fds,
 160                 tcdSigs = sigs,
 161                 tcdMeths = mbinds,
 162                 tcdATs   = ats
 163                 }
 164
 165 mkTyData new_or_data (context, tname, tyvars, typats) ksig data_cons maybe_deriv
 166   = TyData { tcdND = new_or_data, tcdCtxt = context, tcdLName = tname,
 167              tcdTyVars = tyvars, tcdTyPats = typats, tcdCons = data_cons,
 168              tcdKindSig = ksig, tcdDerivs = maybe_deriv }
 169 \end{code}
 170
 171 \begin{code}
 172 mkHsNegApp :: LHsExpr RdrName -> HsExpr RdrName
 173 -- RdrName If the type checker sees (negate 3#) it will barf, because negate
 174 -- can't take an unboxed arg.  But that is exactly what it will see when
 175 -- we write "-3#".  So we have to do the negation right now!
 176 mkHsNegApp (L loc e) = f e
 177   where f (HsLit (HsIntPrim i))    = HsLit (HsIntPrim (-i))
 178         f (HsLit (HsFloatPrim i))  = HsLit (HsFloatPrim (-i))
 179         f (HsLit (HsDoublePrim i)) = HsLit (HsDoublePrim (-i))
 180         f expr                     = NegApp (L loc e) noSyntaxExpr
 181 \end{code}
 182
 183 %************************************************************************
 184 %*                                                                      *
 185 \subsection[cvBinds-etc]{Converting to @HsBinds@, etc.}
 186 %*                                                                      *
 187 %************************************************************************
 188
 189 Function definitions are restructured here. Each is assumed to be recursive
 190 initially, and non recursive definitions are discovered by the dependency
 191 analyser.
 192
 193
 194 \begin{code}
 195 --  | Groups together bindings for a single function
 196 cvTopDecls :: OrdList (LHsDecl RdrName) -> [LHsDecl RdrName]
 197 cvTopDecls decls = go (fromOL decls)
 198   where
 199     go :: [LHsDecl RdrName] -> [LHsDecl RdrName]
 200     go []                   = []
 201     go (L l (ValD b) : ds)  = L l' (ValD b') : go ds'
 202                             where (L l' b', ds') = getMonoBind (L l b) ds
 203     go (d : ds)             = d : go ds
 204
 205 -- Declaration list may only contain value bindings and signatures
 206 --
 207 cvBindGroup :: OrdList (LHsDecl RdrName) -> HsValBinds RdrName
 208 cvBindGroup binding
 209   = case cvBindsAndSigs binding of
 210       (mbs, sigs, []) ->                 -- list of type decls *always* empty
 211         ValBindsIn mbs sigs
 212
 213 cvBindsAndSigs :: OrdList (LHsDecl RdrName)
 214   -> (Bag (LHsBind RdrName), [LSig RdrName], [LTyClDecl RdrName])
 215 -- Input decls contain just value bindings and signatures
 216 -- and in case of class or instance declarations also
 217 -- associated type declarations
 218 cvBindsAndSigs  fb = go (fromOL fb)
 219   where
 220     go []                  = (emptyBag, [], [])
 221     go (L l (SigD s) : ds) = (bs, L l s : ss, ts)
 222                             where (bs, ss, ts) = go ds
 223     go (L l (ValD b) : ds) = (b' `consBag` bs, ss, ts)
 224                             where (b', ds')    = getMonoBind (L l b) ds
 225                                   (bs, ss, ts) = go ds'
 226     go (L l (TyClD t): ds) = (bs, ss, L l t : ts)
 227                             where (bs, ss, ts) = go ds
 228
 229 -----------------------------------------------------------------------------
 230 -- Group function bindings into equation groups
 231
 232 getMonoBind :: LHsBind RdrName -> [LHsDecl RdrName]
 233   -> (LHsBind RdrName, [LHsDecl RdrName])
 234 -- Suppose      (b',ds') = getMonoBind b ds
 235 --      ds is a list of parsed bindings
 236 --      b is a MonoBinds that has just been read off the front
 237
 238 -- Then b' is the result of grouping more equations from ds that
 239 -- belong with b into a single MonoBinds, and ds' is the depleted
 240 -- list of parsed bindings.
 241 --
 242 -- No AndMonoBinds or EmptyMonoBinds here; just single equations
 243
 244 getMonoBind (L loc1 bind@(FunBind { fun_id = fun_id1@(L _ f1), fun_infix = is_infix1,
 245                                    fun_matches = MatchGroup mtchs1 _ })) binds
 246   | has_args mtchs1
 247   = go is_infix1 mtchs1 loc1 binds
 248   where
 249     go is_infix mtchs loc
 250        (L loc2 (ValD (FunBind { fun_id = L _ f2, fun_infix = is_infix2,
 251                                 fun_matches = MatchGroup mtchs2 _ })) : binds)
 252         | f1 == f2 = go (is_infix || is_infix2) (mtchs2 ++ mtchs)
 253                         (combineSrcSpans loc loc2) binds
 254     go is_infix mtchs loc binds
 255         = (L loc (makeFunBind fun_id1 is_infix (reverse mtchs)), binds)
 256         -- Reverse the final matches, to get it back in the right order
 257
 258 getMonoBind bind binds = (bind, binds)
 259
 260 has_args ((L _ (Match args _ _)) : _) = not (null args)
 261         -- Don't group together FunBinds if they have
 262         -- no arguments.  This is necessary now that variable bindings
 263         -- with no arguments are now treated as FunBinds rather
 264         -- than pattern bindings (tests/rename/should_fail/rnfail002).
 265 \end{code}
 266
 267 \begin{code}
 268 findSplice :: [LHsDecl a] -> (HsGroup a, Maybe (SpliceDecl a, [LHsDecl a]))
 269 findSplice ds = addl emptyRdrGroup ds
 270
 271 mkGroup :: [LHsDecl a] -> HsGroup a
 272 mkGroup ds = addImpDecls emptyRdrGroup ds
 273
 274 addImpDecls :: HsGroup a -> [LHsDecl a] -> HsGroup a
 275 -- The decls are imported, and should not have a splice
 276 addImpDecls group decls = case addl group decls of
 277                                 (group', Nothing) -> group'
 278                                 other             -> panic "addImpDecls"
 279
 280 addl :: HsGroup a -> [LHsDecl a] -> (HsGroup a, Maybe (SpliceDecl a, [LHsDecl a]))
 281         -- This stuff reverses the declarations (again) but it doesn't matter
 282
 283 -- Base cases
 284 addl gp []           = (gp, Nothing)
 285 addl gp (L l d : ds) = add gp l d ds
 286
 287
 288 add :: HsGroup a -> SrcSpan -> HsDecl a -> [LHsDecl a]
 289   -> (HsGroup a, Maybe (SpliceDecl a, [LHsDecl a]))
 290
 291 add gp l (SpliceD e) ds = (gp, Just (e, ds))
 292
 293 -- Class declarations: pull out the fixity signatures to the top
 294 add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD d) ds
 295         | isClassDecl d =
 296                 let fsigs = [ L l f | L l (FixSig f) <- tcdSigs d ] in
 297                 addl (gp { hs_tyclds = L l d : ts, hs_fixds  = fsigs ++ fs }) ds
 298         | otherwise =
 299                 addl (gp { hs_tyclds = L l d : ts }) ds
 300
 301 -- Signatures: fixity sigs go a different place than all others
 302 add gp@(HsGroup {hs_fixds = ts}) l (SigD (FixSig f)) ds
 303   = addl (gp {hs_fixds = L l f : ts}) ds
 304 add gp@(HsGroup {hs_valds = ts}) l (SigD d) ds
 305   = addl (gp {hs_valds = add_sig (L l d) ts}) ds
 306
 307 -- Value declarations: use add_bind
 308 add gp@(HsGroup {hs_valds  = ts}) l (ValD d) ds
 309   = addl (gp { hs_valds = add_bind (L l d) ts }) ds
 310
 311 -- The rest are routine
 312 add gp@(HsGroup {hs_instds = ts})  l (InstD d) ds
 313   = addl (gp { hs_instds = L l d : ts }) ds
 314 add gp@(HsGroup {hs_defds  = ts})  l (DefD d) ds
 315   = addl (gp { hs_defds = L l d : ts }) ds
 316 add gp@(HsGroup {hs_fords  = ts})  l (ForD d) ds
 317   = addl (gp { hs_fords = L l d : ts }) ds
 318 add gp@(HsGroup {hs_depds  = ts})  l (DeprecD d) ds
 319   = addl (gp { hs_depds = L l d : ts }) ds
 320 add gp@(HsGroup {hs_ruleds  = ts}) l (RuleD d) ds
 321   = addl (gp { hs_ruleds = L l d : ts }) ds
 322
 323 add_bind b (ValBindsIn bs sigs) = ValBindsIn (bs `snocBag` b) sigs
 324 add_sig  s (ValBindsIn bs sigs) = ValBindsIn bs               (s:sigs)
 325 \end{code}
 326
 327 %************************************************************************
 328 %*                                                                      *
 329 \subsection[PrefixToHS-utils]{Utilities for conversion}
 330 %*                                                                      *
 331 %************************************************************************
 332
 333
 334 \begin{code}
 335 -----------------------------------------------------------------------------
 336 -- mkPrefixCon
 337
 338 -- When parsing data declarations, we sometimes inadvertently parse
 339 -- a constructor application as a type (eg. in data T a b = C a b `D` E a b)
 340 -- This function splits up the type application, adds any pending
 341 -- arguments, and converts the type constructor back into a data constructor.
 342
 343 mkPrefixCon :: LHsType RdrName -> [LBangType RdrName]
 344   -> P (Located RdrName, HsConDetails RdrName (LBangType RdrName))
 345 mkPrefixCon ty tys
 346  = split ty tys
 347  where
 348    split (L _ (HsAppTy t u)) ts = split t (u : ts)
 349    split (L l (HsTyVar tc))  ts = do data_con <- tyConToDataCon l tc
 350                                      return (data_con, PrefixCon ts)
 351    split (L l _) _              = parseError l "parse error in data/newtype declaration"
 352
 353 mkRecCon :: Located RdrName -> [([Located RdrName], LBangType RdrName)]
 354   -> P (Located RdrName, HsConDetails RdrName (LBangType RdrName))
 355 mkRecCon (L loc con) fields
 356   = do data_con <- tyConToDataCon loc con
 357        return (data_con, RecCon [ (l,t) | (ls,t) <- fields, l <- ls ])
 358
 359 tyConToDataCon :: SrcSpan -> RdrName -> P (Located RdrName)
 360 tyConToDataCon loc tc
 361   | isTcOcc (rdrNameOcc tc)
 362   = return (L loc (setRdrNameSpace tc srcDataName))
 363   | otherwise
 364   = parseError loc (showSDoc (text "Not a constructor:" <+> quotes (ppr tc)))
 365
 366 ----------------------------------------------------------------------------
 367 -- Various Syntactic Checks
 368
 369 checkInstType :: LHsType RdrName -> P (LHsType RdrName)
 370 checkInstType (L l t)
 371   = case t of
 372         HsForAllTy exp tvs ctxt ty -> do
 373                 dict_ty <- checkDictTy ty
 374                 return (L l (HsForAllTy exp tvs ctxt dict_ty))
 375
 376         HsParTy ty -> checkInstType ty
 377
 378         ty ->   do dict_ty <- checkDictTy (L l ty)
 379                    return (L l (HsForAllTy Implicit [] (noLoc []) dict_ty))
 380
 381 -- Check whether the given list of type parameters are all type variables
 382 -- (possibly with a kind signature).  If the second argument is `False', we
 383 -- only type variables are allowed and we raise an error on encountering a
 384 -- non-variable; otherwise, we return the entire list parameters iff at least
 385 -- one is not a variable.
 386 --
 387 checkTyVars :: [LHsType RdrName] -> Bool -> P (Maybe [LHsType RdrName])
 388 checkTyVars tparms nonVarsOk =
 389   do
 390     areVars <- mapM chk tparms
 391     return $ if and areVars then Nothing else Just tparms
 392   where
 393         -- Check that the name space is correct!
 394     chk (L l (HsKindSig (L _ (HsTyVar tv)) k))
 395         | isRdrTyVar tv    = return True
 396     chk (L l (HsTyVar tv))
 397         | isRdrTyVar tv    = return True
 398     chk (L l other)
 399         | nonVarsOk        = return False
 400         | otherwise        =
 401           parseError l "Type found where type variable expected"
 402
 403 -- Check whether the type arguments in a type synonym head are simply
 404 -- variables.  If not, we have a type equation of a type function and return
 405 -- all patterns.  If yes, we return 'Nothing' as the third component to
 406 -- indicate a vanilla type synonym.
 407 --
 408 checkSynHdr :: LHsType RdrName
 409             -> Bool                             -- non-variables admitted?
 410             -> P (Located RdrName,              -- head symbol
 411                   [LHsTyVarBndr RdrName],       -- parameters
 412                   Maybe [LHsType RdrName])      -- type patterns
 413 checkSynHdr ty nonVarsOk =
 414   do { (_, tc, tvs, tparms) <- checkTyClHdr (noLoc []) ty
 415      ; typats <- checkTyVars tparms nonVarsOk
 416      ; return (tc, tvs, typats) }
 417
 418
 419 -- Well-formedness check and decomposition of type and class heads.
 420 --
 421 checkTyClHdr :: LHsContext RdrName -> LHsType RdrName
 422   -> P (LHsContext RdrName,          -- the type context
 423         Located RdrName,             -- the head symbol (type or class name)
 424         [LHsTyVarBndr RdrName],      -- free variables of the non-context part
 425         [LHsType RdrName])           -- parameters of head symbol
 426 -- The header of a type or class decl should look like
 427 --      (C a, D b) => T a b
 428 -- or   T a b
 429 -- or   a + b
 430 -- etc
 431 -- With associated types, we can also have non-variable parameters; ie,
 432 --      T Int [a]
 433 -- The unaltered parameter list is returned in the fourth component of the
 434 -- result.  Eg, for
 435 --      T Int [a]
 436 -- we return
 437 --      ('()', 'T', ['a'], ['Int', '[a]'])
 438 checkTyClHdr (L l cxt) ty
 439   = do (tc, tvs, parms) <- gol ty []
 440        mapM_ chk_pred cxt
 441        return (L l cxt, tc, tvs, parms)
 442   where
 443     gol (L l ty) acc = go l ty acc
 444
 445     go l (HsTyVar tc)    acc
 446         | not (isRdrTyVar tc)   = do
 447                                     tvs <- extractTyVars acc
 448                                     return (L l tc, tvs, acc)
 449     go l (HsOpTy t1 tc t2) acc  = do
 450                                     tvs <- extractTyVars (t1:t2:acc)
 451                                     return (tc, tvs, acc)
 452     go l (HsParTy ty)    acc    = gol ty acc
 453     go l (HsAppTy t1 t2) acc    = gol t1 (t2:acc)
 454     go l other           acc    =
 455       parseError l "Malformed head of type or class declaration"
 456
 457         -- The predicates in a type or class decl must all
 458         -- be HsClassPs.  They need not all be type variables,
 459         -- even in Haskell 98.  E.g. class (Monad m, Monad (t m)) => MonadT t m
 460     chk_pred (L l (HsClassP _ args)) = return ()
 461     chk_pred (L l _)
 462        = parseError l "Malformed context in type or class declaration"
 463
 464 -- Extract the type variables of a list of type parameters.
 465 --
 466 -- * Type arguments can be complex type terms (needed for associated type
 467 --   declarations).
 468 --
 469 extractTyVars :: [LHsType RdrName] -> P [LHsTyVarBndr RdrName]
 470 extractTyVars tvs = collects [] tvs
 471   where
 472         -- Collect all variables (1st arg serves as an accumulator)
 473     collect tvs (L l (HsForAllTy _ _ _ _)) =
 474       parseError l "Forall type not allowed as type parameter"
 475     collect tvs (L l (HsTyVar tv))
 476       | isRdrTyVar tv                      = return $ L l (UserTyVar tv) : tvs
 477       | otherwise                          = return tvs
 478     collect tvs (L l (HsBangTy _ _      )) =
 479       parseError l "Bang-style type annotations not allowed as type parameter"
 480     collect tvs (L l (HsAppTy t1 t2     )) = do
 481                                                tvs' <- collect tvs t2
 482                                                collect tvs' t1
 483     collect tvs (L l (HsFunTy t1 t2     )) = do
 484                                                tvs' <- collect tvs t2
 485                                                collect tvs' t1
 486     collect tvs (L l (HsListTy t        )) = collect tvs t
 487     collect tvs (L l (HsPArrTy t        )) = collect tvs t
 488     collect tvs (L l (HsTupleTy _ ts    )) = collects tvs ts
 489     collect tvs (L l (HsOpTy t1 _ t2    )) = do
 490                                                tvs' <- collect tvs t2
 491                                                collect tvs' t1
 492     collect tvs (L l (HsParTy t         )) = collect tvs t
 493     collect tvs (L l (HsNumTy t         )) = return tvs
 494     collect tvs (L l (HsPredTy t        )) =
 495       parseError l "Predicate not allowed as type parameter"
 496     collect tvs (L l (HsKindSig (L _ (HsTyVar tv)) k))
 497         | isRdrTyVar tv                    =
 498           return $ L l (KindedTyVar tv k) : tvs
 499         | otherwise                        =
 500           parseError l "Kind signature only allowed for type variables"
 501     collect tvs (L l (HsSpliceTy t      )) =
 502       parseError l "Splice not allowed as type parameter"
 503
 504         -- Collect all variables of a list of types
 505     collects tvs []     = return tvs
 506     collects tvs (t:ts) = do
 507                             tvs' <- collects tvs ts
 508                             collect tvs' t
 509
 510 -- Check that associated type declarations of a class are all kind signatures.
 511 --
 512 checkKindSigs :: [LTyClDecl RdrName] -> P ()
 513 checkKindSigs = mapM_ check
 514   where
 515     check (L l tydecl)
 516       | isKindSigDecl tydecl
 517         || isSynDecl tydecl  = return ()
 518       | otherwise            =
 519         parseError l "Type declaration in a class must be a kind signature or synonym default"
 520
 521 -- Wrap a toplevel type or data declaration into 'TyClD' and ensure for
 522 -- data declarations that all type parameters are variables only (which is in
 523 -- contrast to type functions and associated type declarations).
 524 --
 525 checkTopTypeD :: LTyClDecl RdrName -> P (HsDecl RdrName)
 526 checkTopTypeD (L _ d@TyData {tcdTyPats = Just typats}) =
 527   do
 528     -- `tcdTyPats' will only be of the form `Just typats' if `typats' contains
 529     -- a non-variable pattern.  We call `checkTyPats' instead of raising an
 530     -- error straight away, as `checkTyPats' raises the error at the location
 531     -- of that non-variable pattern.
 532     --
 533     checkTyVars typats False
 534     panic "checkTopTypeD: check on previous line should fail w/ a parse error"
 535 checkTopTypeD (L _ d) = return $ TyClD d
 536
 537 checkContext :: LHsType RdrName -> P (LHsContext RdrName)
 538 checkContext (L l t)
 539   = check t
 540  where
 541   check (HsTupleTy _ ts)        -- (Eq a, Ord b) shows up as a tuple type
 542     = do ctx <- mapM checkPred ts
 543          return (L l ctx)
 544
 545   check (HsParTy ty)    -- to be sure HsParTy doesn't get into the way
 546     = check (unLoc ty)
 547
 548   check (HsTyVar t)     -- Empty context shows up as a unit type ()
 549     | t == getRdrName unitTyCon = return (L l [])
 550
 551   check t
 552     = do p <- checkPred (L l t)
 553          return (L l [p])
 554
 555
 556 checkPred :: LHsType RdrName -> P (LHsPred RdrName)
 557 -- Watch out.. in ...deriving( Show )... we use checkPred on
 558 -- the list of partially applied predicates in the deriving,
 559 -- so there can be zero args.
 560 checkPred (L spn (HsPredTy (HsIParam n ty)))
 561   = return (L spn (HsIParam n ty))
 562 checkPred (L spn ty)
 563   = check spn ty []
 564   where
 565     checkl (L l ty) args = check l ty args
 566
 567     check _loc (HsTyVar t)             args | not (isRdrTyVar t)
 568                                             = return (L spn (HsClassP t args))
 569     check _loc (HsAppTy l r)           args = checkl l (r:args)
 570     check _loc (HsOpTy l (L loc tc) r) args = check loc (HsTyVar tc) (l:r:args)
 571     check _loc (HsParTy t)             args = checkl t args
 572     check loc _                        _    = parseError loc  "malformed class assertion"
 573
 574 checkDictTy :: LHsType RdrName -> P (LHsType RdrName)
 575 checkDictTy (L spn ty) = check ty []
 576   where
 577   check (HsTyVar t) args | not (isRdrTyVar t)
 578         = return (L spn (HsPredTy (HsClassP t args)))
 579   check (HsAppTy l r) args = check (unLoc l) (r:args)
 580   check (HsParTy t)   args = check (unLoc t) args
 581   check _ _ = parseError spn "Malformed context in instance header"
 582
 583 ---------------------------------------------------------------------------
 584 -- Checking statements in a do-expression
 585 --      We parse   do { e1 ; e2 ; }
 586 --      as [ExprStmt e1, ExprStmt e2]
 587 -- checkDo (a) checks that the last thing is an ExprStmt
 588 --         (b) returns it separately
 589 -- same comments apply for mdo as well
 590
 591 checkDo  = checkDoMDo "a " "'do'"
 592 checkMDo = checkDoMDo "an " "'mdo'"
 593
 594 checkDoMDo :: String -> String -> SrcSpan -> [LStmt RdrName] -> P ([LStmt RdrName], LHsExpr RdrName)
 595 checkDoMDo pre nm loc []   = parseError loc ("Empty " ++ nm ++ " construct")
 596 checkDoMDo pre nm loc ss   = do
 597   check ss
 598   where
 599         check  [L l (ExprStmt e _ _)] = return ([], e)
 600         check  [L l _] = parseError l ("The last statement in " ++ pre ++ nm ++
 601                                          " construct must be an expression")
 602         check (s:ss) = do
 603           (ss',e') <-  check ss
 604           return ((s:ss'),e')
 605
 606 -- -------------------------------------------------------------------------
 607 -- Checking Patterns.
 608
 609 -- We parse patterns as expressions and check for valid patterns below,
 610 -- converting the expression into a pattern at the same time.
 611
 612 checkPattern :: LHsExpr RdrName -> P (LPat RdrName)
 613 checkPattern e = checkLPat e
 614
 615 checkPatterns :: [LHsExpr RdrName] -> P [LPat RdrName]
 616 checkPatterns es = mapM checkPattern es
 617
 618 checkLPat :: LHsExpr RdrName -> P (LPat RdrName)
 619 checkLPat e@(L l _) = checkPat l e []
 620
 621 checkPat :: SrcSpan -> LHsExpr RdrName -> [LPat RdrName] -> P (LPat RdrName)
 622 checkPat loc (L l (HsVar c)) args
 623   | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
 624 checkPat loc e args     -- OK to let this happen even if bang-patterns
 625                         -- are not enabled, because there is no valid
 626                         -- non-bang-pattern parse of (C ! e)
 627   | Just (e', args') <- splitBang e
 628   = do  { args'' <- checkPatterns args'
 629         ; checkPat loc e' (args'' ++ args) }
 630 checkPat loc (L _ (HsApp f x)) args
 631   = do { x <- checkLPat x; checkPat loc f (x:args) }
 632 checkPat loc (L _ e) []
 633   = do { p <- checkAPat loc e; return (L loc p) }
 634 checkPat loc pat _some_args
 635   = patFail loc
 636
 637 checkAPat loc e = case e of
 638    EWildPat            -> return (WildPat placeHolderType)
 639    HsVar x | isQual x  -> parseError loc ("Qualified variable in pattern: "
 640                                          ++ showRdrName x)
 641            | otherwise -> return (VarPat x)
 642    HsLit l             -> return (LitPat l)
 643
 644    -- Overloaded numeric patterns (e.g. f 0 x = x)
 645    -- Negation is recorded separately, so that the literal is zero or +ve
 646    -- NB. Negative *primitive* literals are already handled by
 647    --     RdrHsSyn.mkHsNegApp
 648    HsOverLit pos_lit            -> return (mkNPat pos_lit Nothing)
 649    NegApp (L _ (HsOverLit pos_lit)) _
 650                         -> return (mkNPat pos_lit (Just noSyntaxExpr))
 651
 652    SectionR (L _ (HsVar bang)) e        -- (! x)
 653         | bang == bang_RDR
 654         -> do { bang_on <- extension bangPatEnabled
 655               ; if bang_on then checkLPat e >>= (return . BangPat)
 656                 else parseError loc "Illegal bang-pattern (use -fbang-patterns)" }
 657
 658    ELazyPat e         -> checkLPat e >>= (return . LazyPat)
 659    EAsPat n e         -> checkLPat e >>= (return . AsPat n)
 660    ExprWithTySig e t  -> checkLPat e >>= \e ->
 661                          -- Pattern signatures are parsed as sigtypes,
 662                          -- but they aren't explicit forall points.  Hence
 663                          -- we have to remove the implicit forall here.
 664                          let t' = case t of
 665                                      L _ (HsForAllTy Implicit _ (L _ []) ty) -> ty
 666                                      other -> other
 667                          in
 668                          return (SigPatIn e t')
 669
 670    -- n+k patterns
 671    OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _
 672         (L _ (HsOverLit lit@(HsIntegral _ _)))
 673                       | plus == plus_RDR
 674                       -> return (mkNPlusKPat (L nloc n) lit)
 675
 676    OpApp l op fix r   -> checkLPat l >>= \l ->
 677                          checkLPat r >>= \r ->
 678                          case op of
 679                             L cl (HsVar c) | isDataOcc (rdrNameOcc c)
 680                                    -> return (ConPatIn (L cl c) (InfixCon l r))
 681                             _ -> patFail loc
 682
 683    HsPar e                 -> checkLPat e >>= (return . ParPat)
 684    ExplicitList _ es  -> mapM (\e -> checkLPat e) es >>= \ps ->
 685                          return (ListPat ps placeHolderType)
 686    ExplicitPArr _ es  -> mapM (\e -> checkLPat e) es >>= \ps ->
 687                          return (PArrPat ps placeHolderType)
 688
 689    ExplicitTuple es b -> mapM (\e -> checkLPat e) es >>= \ps ->
 690                          return (TuplePat ps b placeHolderType)
 691
 692    RecordCon c _ fs   -> mapM checkPatField fs >>= \fs ->
 693                          return (ConPatIn c (RecCon fs))
 694 -- Generics
 695    HsType ty          -> return (TypePat ty)
 696    _                  -> patFail loc
 697
 698 plus_RDR, bang_RDR :: RdrName
 699 plus_RDR = mkUnqual varName FSLIT("+")  -- Hack
 700 bang_RDR = mkUnqual varName FSLIT("!")  -- Hack
 701
 702 checkPatField :: (Located RdrName, LHsExpr RdrName) -> P (Located RdrName, LPat RdrName)
 703 checkPatField (n,e) = do
 704   p <- checkLPat e
 705   return (n,p)
 706
 707 patFail loc = parseError loc "Parse error in pattern"
 708
 709
 710 ---------------------------------------------------------------------------
 711 -- Check Equation Syntax
 712
 713 checkValDef :: LHsExpr RdrName
 714             -> Maybe (LHsType RdrName)
 715             -> Located (GRHSs RdrName)
 716             -> P (HsBind RdrName)
 717
 718 checkValDef lhs (Just sig) grhss
 719         -- x :: ty = rhs  parses as a *pattern* binding
 720   = checkPatBind (L (combineLocs lhs sig) (ExprWithTySig lhs sig)) grhss
 721
 722 checkValDef lhs opt_sig grhss
 723   = do  { mb_fun <- isFunLhs lhs
 724         ; case mb_fun of
 725             Just (fun, is_infix, pats) -> checkFunBind (getLoc lhs)
 726                                                 fun is_infix pats opt_sig grhss
 727             Nothing -> checkPatBind lhs grhss }
 728
 729 checkFunBind lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
 730   | isQual (unLoc fun)
 731   = parseError (getLoc fun) ("Qualified name in function definition: "  ++
 732                              showRdrName (unLoc fun))
 733   | otherwise
 734   = do  ps <- checkPatterns pats
 735         let match_span = combineSrcSpans lhs_loc rhs_span
 736         return (makeFunBind fun is_infix [L match_span (Match ps opt_sig grhss)])
 737         -- The span of the match covers the entire equation.
 738         -- That isn't quite right, but it'll do for now.
 739
 740 makeFunBind :: Located id -> Bool -> [LMatch id] -> HsBind id
 741 -- Like HsUtils.mkFunBind, but we need to be able to set the fixity too
 742 makeFunBind fn is_infix ms
 743   = FunBind { fun_id = fn, fun_infix = is_infix, fun_matches = mkMatchGroup ms,
 744               fun_co_fn = idCoercion, bind_fvs = placeHolderNames }
 745
 746 checkPatBind lhs (L _ grhss)
 747   = do  { lhs <- checkPattern lhs
 748         ; return (PatBind lhs grhss placeHolderType placeHolderNames) }
 749
 750 checkValSig
 751         :: LHsExpr RdrName
 752         -> LHsType RdrName
 753         -> P (Sig RdrName)
 754 checkValSig (L l (HsVar v)) ty
 755   | isUnqual v && not (isDataOcc (rdrNameOcc v))
 756   = return (TypeSig (L l v) ty)
 757 checkValSig (L l other)     ty
 758   = parseError l "Invalid type signature"
 759
 760 mkGadtDecl :: Located RdrName
 761            -> LHsType RdrName -- assuming HsType
 762            -> ConDecl RdrName
 763 mkGadtDecl name (L _ (HsForAllTy _ qvars cxt ty)) = mk_gadt_con name qvars cxt ty
 764 mkGadtDecl name ty                                = mk_gadt_con name [] (noLoc []) ty
 765
 766 mk_gadt_con name qvars cxt ty
 767   = ConDecl { con_name     = name
 768             , con_explicit = Implicit
 769             , con_qvars    = qvars
 770             , con_cxt      = cxt
 771             , con_details  = PrefixCon []
 772             , con_res      = ResTyGADT ty }
 773   -- NB: we put the whole constr type into the ResTyGADT for now;
 774   -- the renamer will unravel it once it has sorted out
 775   -- operator fixities
 776
 777 -- A variable binding is parsed as a FunBind.
 778
 779
 780         -- The parser left-associates, so there should
 781         -- not be any OpApps inside the e's
 782 splitBang :: LHsExpr RdrName -> Maybe (LHsExpr RdrName, [LHsExpr RdrName])
 783 -- Splits (f ! g a b) into (f, [(! g), a, g])
 784 splitBang (L loc (OpApp l_arg bang@(L loc' (HsVar op)) _ r_arg))
 785   | op == bang_RDR = Just (l_arg, L loc (SectionR bang arg1) : argns)
 786   where
 787     (arg1,argns) = split_bang r_arg []
 788     split_bang (L _ (HsApp f e)) es = split_bang f (e:es)
 789     split_bang e                 es = (e,es)
 790 splitBang other = Nothing
 791
 792 isFunLhs :: LHsExpr RdrName
 793          -> P (Maybe (Located RdrName, Bool, [LHsExpr RdrName]))
 794 -- Just (fun, is_infix, arg_pats) if e is a function LHS
 795 isFunLhs e = go e []
 796  where
 797    go (L loc (HsVar f)) es
 798         | not (isRdrDataCon f)   = return (Just (L loc f, False, es))
 799    go (L _ (HsApp f e)) es       = go f (e:es)
 800    go (L _ (HsPar e))   es@(_:_) = go e es
 801
 802         -- For infix function defns, there should be only one infix *function*
 803         -- (though there may be infix *datacons* involved too).  So we don't
 804         -- need fixity info to figure out which function is being defined.
 805         --      a `K1` b `op` c `K2` d
 806         -- must parse as
 807         --      (a `K1` b) `op` (c `K2` d)
 808         -- The renamer checks later that the precedences would yield such a parse.
 809         --
 810         -- There is a complication to deal with bang patterns.
 811         --
 812         -- ToDo: what about this?
 813         --              x + 1 `op` y = ...
 814
 815    go e@(L loc (OpApp l (L loc' (HsVar op)) fix r)) es
 816         | Just (e',es') <- splitBang e
 817         = do { bang_on <- extension bangPatEnabled
 818              ; if bang_on then go e' (es' ++ es)
 819                else return (Just (L loc' op, True, (l:r:es))) }
 820                 -- No bangs; behave just like the next case
 821         | not (isRdrDataCon op)         -- We have found the function!
 822         = return (Just (L loc' op, True, (l:r:es)))
 823         | otherwise                     -- Infix data con; keep going
 824         = do { mb_l <- go l es
 825              ; case mb_l of
 826                  Just (op', True, j : k : es')
 827                     -> return (Just (op', True, j : op_app : es'))
 828                     where
 829                       op_app = L loc (OpApp k (L loc' (HsVar op)) fix r)
 830                  _ -> return Nothing }
 831    go _ _ = return Nothing
 832
 833 ---------------------------------------------------------------------------
 834 -- Miscellaneous utilities
 835
 836 checkPrecP :: Located Int -> P Int
 837 checkPrecP (L l i)
 838  | 0 <= i && i <= maxPrecedence = return i
 839  | otherwise                    = parseError l "Precedence out of range"
 840
 841 mkRecConstrOrUpdate
 842         :: LHsExpr RdrName
 843         -> SrcSpan
 844         -> HsRecordBinds RdrName
 845         -> P (HsExpr RdrName)
 846
 847 mkRecConstrOrUpdate (L l (HsVar c)) loc fs | isRdrDataCon c
 848   = return (RecordCon (L l c) noPostTcExpr fs)
 849 mkRecConstrOrUpdate exp loc fs@(_:_)
 850   = return (RecordUpd exp fs placeHolderType placeHolderType)
 851 mkRecConstrOrUpdate _ loc []
 852   = parseError loc "Empty record update"
 853
 854 mkInlineSpec :: Maybe Activation -> Bool -> InlineSpec
 855 -- The Maybe is becuase the user can omit the activation spec (and usually does)
 856 mkInlineSpec Nothing    True  = alwaysInlineSpec        -- INLINE
 857 mkInlineSpec Nothing    False = neverInlineSpec         -- NOINLINE
 858 mkInlineSpec (Just act) inl   = Inline act inl
 859
 860
 861 -----------------------------------------------------------------------------
 862 -- utilities for foreign declarations
 863
 864 -- supported calling conventions
 865 --
 866 data CallConv = CCall  CCallConv        -- ccall or stdcall
 867               | DNCall                  -- .NET
 868
 869 -- construct a foreign import declaration
 870 --
 871 mkImport :: CallConv
 872          -> Safety
 873          -> (Located FastString, Located RdrName, LHsType RdrName)
 874          -> P (HsDecl RdrName)
 875 mkImport (CCall  cconv) safety (entity, v, ty) = do
 876   importSpec <- parseCImport entity cconv safety v
 877   return (ForD (ForeignImport v ty importSpec))
 878 mkImport (DNCall      ) _      (entity, v, ty) = do
 879   spec <- parseDImport entity
 880   return $ ForD (ForeignImport v ty (DNImport spec))
 881
 882 -- parse the entity string of a foreign import declaration for the `ccall' or
 883 -- `stdcall' calling convention'
 884 --
 885 parseCImport :: Located FastString
 886              -> CCallConv
 887              -> Safety
 888              -> Located RdrName
 889              -> P ForeignImport
 890 parseCImport (L loc entity) cconv safety v
 891   -- FIXME: we should allow white space around `dynamic' and `wrapper' -=chak
 892   | entity == FSLIT ("dynamic") =
 893     return $ CImport cconv safety nilFS nilFS (CFunction DynamicTarget)
 894   | entity == FSLIT ("wrapper") =
 895     return $ CImport cconv safety nilFS nilFS CWrapper
 896   | otherwise                  = parse0 (unpackFS entity)
 897     where
 898       -- using the static keyword?
 899       parse0 (' ':                    rest) = parse0 rest
 900       parse0 ('s':'t':'a':'t':'i':'c':rest) = parse1 rest
 901       parse0                          rest  = parse1 rest
 902       -- check for header file name
 903       parse1     ""               = parse4 ""    nilFS        False nilFS
 904       parse1     (' ':rest)       = parse1 rest
 905       parse1 str@('&':_   )       = parse2 str   nilFS
 906       parse1 str@('[':_   )       = parse3 str   nilFS        False
 907       parse1 str
 908         | ".h" `isSuffixOf` first = parse2 rest  (mkFastString first)
 909         | otherwise               = parse4 str   nilFS        False nilFS
 910         where
 911           (first, rest) = break (\c -> c == ' ' || c == '&' || c == '[') str
 912       -- check for address operator (indicating a label import)
 913       parse2     ""         header = parse4 ""   header False nilFS
 914       parse2     (' ':rest) header = parse2 rest header
 915       parse2     ('&':rest) header = parse3 rest header True
 916       parse2 str@('[':_   ) header = parse3 str  header False
 917       parse2 str            header = parse4 str  header False nilFS
 918       -- check for library object name
 919       parse3 (' ':rest) header isLbl = parse3 rest header isLbl
 920       parse3 ('[':rest) header isLbl =
 921         case break (== ']') rest of
 922           (lib, ']':rest)           -> parse4 rest header isLbl (mkFastString lib)
 923           _                         -> parseError loc "Missing ']' in entity"
 924       parse3 str        header isLbl = parse4 str  header isLbl nilFS
 925       -- check for name of C function
 926       parse4 ""         header isLbl lib = build (mkExtName (unLoc v)) header isLbl lib
 927       parse4 (' ':rest) header isLbl lib = parse4 rest                 header isLbl lib
 928       parse4 str        header isLbl lib
 929         | all (== ' ') rest              = build (mkFastString first)  header isLbl lib
 930         | otherwise                      = parseError loc "Malformed entity string"
 931         where
 932           (first, rest) = break (== ' ') str
 933       --
 934       build cid header False lib = return $
 935         CImport cconv safety header lib (CFunction (StaticTarget cid))
 936       build cid header True  lib = return $
 937         CImport cconv safety header lib (CLabel                  cid )
 938
 939 --
 940 -- Unravel a dotnet spec string.
 941 --
 942 parseDImport :: Located FastString -> P DNCallSpec
 943 parseDImport (L loc entity) = parse0 comps
 944  where
 945   comps = words (unpackFS entity)
 946
 947   parse0 [] = d'oh
 948   parse0 (x : xs)
 949     | x == "static" = parse1 True xs
 950     | otherwise     = parse1 False (x:xs)
 951
 952   parse1 _ [] = d'oh
 953   parse1 isStatic (x:xs)
 954     | x == "method" = parse2 isStatic DNMethod xs
 955     | x == "field"  = parse2 isStatic DNField xs
 956     | x == "ctor"   = parse2 isStatic DNConstructor xs
 957   parse1 isStatic xs = parse2 isStatic DNMethod xs
 958
 959   parse2 _ _ [] = d'oh
 960   parse2 isStatic kind (('[':x):xs) =
 961      case x of
 962         [] -> d'oh
 963         vs | last vs == ']' -> parse3 isStatic kind (init vs) xs
 964   parse2 isStatic kind xs = parse3 isStatic kind "" xs
 965
 966   parse3 isStatic kind assem [x] =
 967     return (DNCallSpec isStatic kind assem x
 968                           -- these will be filled in once known.
 969                         (error "FFI-dotnet-args")
 970                         (error "FFI-dotnet-result"))
 971   parse3 _ _ _ _ = d'oh
 972
 973   d'oh = parseError loc "Malformed entity string"
 974
 975 -- construct a foreign export declaration
 976 --
 977 mkExport :: CallConv
 978          -> (Located FastString, Located RdrName, LHsType RdrName)
 979          -> P (HsDecl RdrName)
 980 mkExport (CCall  cconv) (L loc entity, v, ty) = return $
 981   ForD (ForeignExport v ty (CExport (CExportStatic entity' cconv)))
 982   where
 983     entity' | nullFS entity = mkExtName (unLoc v)
 984             | otherwise     = entity
 985 mkExport DNCall (L loc entity, v, ty) =
 986   parseError (getLoc v){-TODO: not quite right-}
 987         "Foreign export is not yet supported for .NET"
 988
 989 -- Supplying the ext_name in a foreign decl is optional; if it
 990 -- isn't there, the Haskell name is assumed. Note that no transformation
 991 -- of the Haskell name is then performed, so if you foreign export (++),
 992 -- it's external name will be "++". Too bad; it's important because we don't
 993 -- want z-encoding (e.g. names with z's in them shouldn't be doubled)
 994 --
 995 mkExtName :: RdrName -> CLabelString
 996 mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm))
 997 \end{code}
 998
 999
1000 -----------------------------------------------------------------------------
1001 -- Misc utils
1002
1003 \begin{code}
1004 showRdrName :: RdrName -> String
1005 showRdrName r = showSDoc (ppr r)
1006
1007 parseError :: SrcSpan -> String -> P a
1008 parseError span s = failSpanMsgP span s
1009 \end{code}