rebase to ghc main repo
[ghc-hetmet.git] / 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, 
12         mkHsIntegral, mkHsFractional, mkHsIsString,
13         mkHsDo, mkHsSplice, mkTopSpliceDecl,
14         mkClassDecl, mkTyData, mkTyFamily, mkTySynonym,
15         splitCon, mkInlinePragma,       
16         mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
17
18         cvBindGroup,
19         cvBindsAndSigs,
20         cvTopDecls,
21         placeHolderPunRhs,
22
23         -- Stuff to do with Foreign declarations
24         mkImport,
25         parseCImport,
26         mkExport,
27         mkExtName,           -- RdrName -> CLabelString
28         mkGadtDecl,          -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName
29         mkSimpleConDecl, 
30         mkDeprecatedGadtRecordDecl,
31
32         -- Bunch of functions in the parser monad for 
33         -- checking and constructing values
34         checkPrecP,           -- Int -> P Int
35         checkContext,         -- HsType -> P HsContext
36         checkPred,            -- HsType -> P HsPred
37         checkTyVars,          -- [LHsType RdrName] -> P ()
38         checkKindSigs,        -- [LTyClDecl RdrName] -> P ()
39         checkInstType,        -- HsType -> P HsType
40         checkPattern,         -- HsExp -> P HsPat
41         bang_RDR,
42         checkPatterns,        -- SrcLoc -> [HsExp] -> P [HsPat]
43         checkDo,              -- [Stmt] -> P [Stmt]
44         checkMDo,             -- [Stmt] -> P [Stmt]
45         checkValDef,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
46         checkValSig,          -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
47         checkDoAndIfThenElse,
48         parseError,         
49         parseErrorSDoc,     
50     ) where
51
52 import HsSyn            -- Lots of it
53 import Class            ( FunDep )
54 import TypeRep          ( Kind )
55 import RdrName          ( RdrName, isRdrTyVar, isRdrTc, mkUnqual, rdrNameOcc, 
56                           isRdrDataCon, isUnqual, getRdrName, setRdrNameSpace )
57 import BasicTypes       ( maxPrecedence, Activation(..), RuleMatchInfo,
58                           InlinePragma(..), InlineSpec(..) )
59 import Lexer
60 import TysWiredIn       ( unitTyCon ) 
61 import ForeignCall
62 import OccName          ( srcDataName, varName, isDataOcc, isTcOcc, 
63                           occNameString )
64 import PrelNames        ( forall_tv_RDR )
65 import DynFlags
66 import SrcLoc
67 import OrdList          ( OrdList, fromOL )
68 import Bag              ( Bag, emptyBag, consBag, foldrBag )
69 import Outputable
70 import FastString
71 import Maybes
72
73 import Control.Applicative ((<$>))       
74 import Control.Monad
75 import Text.ParserCombinators.ReadP as ReadP
76 import Data.List        ( nubBy )
77 import Data.Char
78
79 #include "HsVersions.h"
80 \end{code}
81
82
83 %************************************************************************
84 %*                                                                      *
85 \subsection{A few functions over HsSyn at RdrName}
86 %*                                                                    *
87 %************************************************************************
88
89 extractHsTyRdrNames finds the free variables of a HsType
90 It's used when making the for-alls explicit.
91
92 \begin{code}
93 extractHsTyRdrTyVars :: LHsType RdrName -> [Located RdrName]
94 extractHsTyRdrTyVars ty = nubBy eqLocated (extract_lty ty [])
95
96 extractHsTysRdrTyVars :: [LHsType RdrName] -> [Located RdrName]
97 extractHsTysRdrTyVars ty = nubBy eqLocated (extract_ltys ty [])
98
99 extractHsRhoRdrTyVars :: LHsContext RdrName -> LHsType RdrName -> [Located RdrName]
100 -- This one takes the context and tau-part of a 
101 -- sigma type and returns their free type variables
102 extractHsRhoRdrTyVars ctxt ty 
103  = nubBy eqLocated $ extract_lctxt ctxt (extract_lty ty [])
104
105 extract_lctxt :: Located [LHsPred RdrName] -> [Located RdrName] -> [Located RdrName]
106 extract_lctxt ctxt acc = foldr (extract_pred . unLoc) acc (unLoc ctxt)
107
108 extract_pred :: HsPred RdrName -> [Located RdrName] -> [Located RdrName]
109 extract_pred (HsClassP _   tys) acc = extract_ltys tys acc
110 extract_pred (HsEqualP ty1 ty2) acc = extract_lty ty1 (extract_lty ty2 acc)
111 extract_pred (HsIParam _   ty ) acc = extract_lty ty acc
112
113 extract_ltys :: [LHsType RdrName] -> [Located RdrName] -> [Located RdrName]
114 extract_ltys tys acc = foldr extract_lty acc tys
115
116 extract_lty :: LHsType RdrName -> [Located RdrName] -> [Located RdrName]
117 extract_lty (L loc ty) acc 
118   = case ty of
119       HsTyVar tv                -> extract_tv loc tv acc
120       HsBangTy _ ty             -> extract_lty ty acc
121       HsRecTy flds              -> foldr (extract_lty . cd_fld_type) acc flds
122       HsAppTy ty1 ty2           -> extract_lty ty1 (extract_lty ty2 acc)
123       HsListTy ty               -> extract_lty ty acc
124       HsPArrTy ty               -> extract_lty ty acc
125       HsModalBoxType ecn ty     -> extract_lty ty acc
126       HsTupleTy _ tys           -> extract_ltys tys acc
127       HsFunTy ty1 ty2           -> extract_lty ty1 (extract_lty ty2 acc)
128       HsPredTy p                -> extract_pred p acc
129       HsOpTy ty1 (L loc tv) ty2 -> extract_tv loc tv (extract_lty ty1 (extract_lty ty2 acc))
130       HsParTy ty                -> extract_lty ty acc
131       HsNumTy {}                -> acc
132       HsCoreTy {}               -> acc  -- The type is closed
133       HsQuasiQuoteTy {}         -> acc  -- Quasi quotes mention no type variables
134       HsSpliceTy {}             -> acc  -- Type splices mention no type variables
135       HsKindSig ty _            -> extract_lty ty acc
136       HsForAllTy _ [] cx ty     -> extract_lctxt cx (extract_lty ty acc)
137       HsForAllTy _ tvs cx ty    -> acc ++ (filter ((`notElem` locals) . unLoc) $
138                                            extract_lctxt cx (extract_lty ty []))
139                                 where
140                                    locals = hsLTyVarNames tvs
141       HsDocTy ty _              -> extract_lty ty acc
142
143 extract_tv :: SrcSpan -> RdrName -> [Located RdrName] -> [Located RdrName]
144 extract_tv loc tv acc | isRdrTyVar tv = L loc tv : acc
145                       | otherwise     = acc
146
147 extractGenericPatTyVars :: LHsBinds RdrName -> [Located RdrName]
148 -- Get the type variables out of the type patterns in a bunch of
149 -- possibly-generic bindings in a class declaration
150 extractGenericPatTyVars binds
151   = nubBy eqLocated (foldrBag get [] binds)
152   where
153     get (L _ (FunBind { fun_matches = MatchGroup ms _ })) acc = foldr (get_m.unLoc) acc ms
154     get _                                                 acc = acc
155
156     get_m (Match (L _ (TypePat ty) : _) _ _) acc = extract_lty ty acc
157     get_m _                                        acc = acc
158 \end{code}
159
160
161 %************************************************************************
162 %*                                                                      *
163 \subsection{Construction functions for Rdr stuff}
164 %*                                                                    *
165 %************************************************************************
166
167 mkClassDecl builds a RdrClassDecl, filling in the names for tycon and datacon
168 by deriving them from the name of the class.  We fill in the names for the
169 tycon and datacon corresponding to the class, by deriving them from the
170 name of the class itself.  This saves recording the names in the interface
171 file (which would be equally good).
172
173 Similarly for mkConDecl, mkClassOpSig and default-method names.
174
175         *** See "THE NAMING STORY" in HsDecls ****
176   
177 \begin{code}
178 mkClassDecl :: SrcSpan
179             -> Located (Maybe (LHsContext RdrName), LHsType RdrName)
180             -> Located [Located (FunDep RdrName)]
181             -> Located (OrdList (LHsDecl RdrName))
182             -> P (LTyClDecl RdrName)
183
184 mkClassDecl loc (L _ (mcxt, tycl_hdr)) fds where_cls
185   = do { let (binds, sigs, ats, docs) = cvBindsAndSigs (unLoc where_cls)
186        ; let cxt = fromMaybe (noLoc []) mcxt
187        ; (cls, tparams) <- checkTyClHdr tycl_hdr
188        ; tyvars <- checkTyVars tparams      -- Only type vars allowed
189        ; checkKindSigs ats
190        ; return (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, tcdTyVars = tyvars,
191                                     tcdFDs = unLoc fds, tcdSigs = sigs, tcdMeths = binds,
192                                     tcdATs   = ats, tcdDocs  = docs })) }
193
194 mkTyData :: SrcSpan
195          -> NewOrData
196          -> Bool                -- True <=> data family instance
197          -> Located (Maybe (LHsContext RdrName), LHsType RdrName)
198          -> Maybe Kind
199          -> [LConDecl RdrName]
200          -> Maybe [LHsType RdrName]
201          -> P (LTyClDecl RdrName)
202 mkTyData loc new_or_data is_family (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
203   = do { (tc, tparams) <- checkTyClHdr tycl_hdr
204
205        ; checkDatatypeContext mcxt
206        ; let cxt = fromMaybe (noLoc []) mcxt
207        ; (tyvars, typats) <- checkTParams is_family tparams
208        ; return (L loc (TyData { tcdND = new_or_data, tcdCtxt = cxt, tcdLName = tc,
209                                  tcdTyVars = tyvars, tcdTyPats = typats, 
210                                  tcdCons = data_cons, 
211                                  tcdKindSig = ksig, tcdDerivs = maybe_deriv })) }
212
213 mkTySynonym :: SrcSpan 
214             -> Bool             -- True <=> type family instances
215             -> LHsType RdrName  -- LHS
216             -> LHsType RdrName  -- RHS
217             -> P (LTyClDecl RdrName)
218 mkTySynonym loc is_family lhs rhs
219   = do { (tc, tparams) <- checkTyClHdr lhs
220        ; (tyvars, typats) <- checkTParams is_family tparams
221        ; return (L loc (TySynonym tc tyvars typats rhs)) }
222
223 mkTyFamily :: SrcSpan
224            -> FamilyFlavour
225            -> LHsType RdrName   -- LHS
226            -> Maybe Kind        -- Optional kind signature
227            -> P (LTyClDecl RdrName)
228 mkTyFamily loc flavour lhs ksig
229   = do { (tc, tparams) <- checkTyClHdr lhs
230        ; tyvars <- checkTyVars tparams
231        ; return (L loc (TyFamily flavour tc tyvars ksig)) }
232
233 mkTopSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName
234 -- If the user wrote
235 --      [pads| ... ]   then return a QuasiQuoteD
236 --      $(e)           then return a SpliceD
237 -- but if she wrote, say,
238 --      f x            then behave as if she'd written $(f x)
239 --                     ie a SpliceD
240 mkTopSpliceDecl (L _ (HsQuasiQuoteE qq))            = QuasiQuoteD qq
241 mkTopSpliceDecl (L _ (HsSpliceE (HsSplice _ expr))) = SpliceD (SpliceDecl expr       Explicit)
242 mkTopSpliceDecl other_expr                          = SpliceD (SpliceDecl other_expr Implicit)
243 \end{code}
244
245 %************************************************************************
246 %*                                                                      *
247 \subsection[cvBinds-etc]{Converting to @HsBinds@, etc.}
248 %*                                                                      *
249 %************************************************************************
250
251 Function definitions are restructured here. Each is assumed to be recursive
252 initially, and non recursive definitions are discovered by the dependency
253 analyser.
254
255
256 \begin{code}
257 --  | Groups together bindings for a single function
258 cvTopDecls :: OrdList (LHsDecl RdrName) -> [LHsDecl RdrName]
259 cvTopDecls decls = go (fromOL decls)
260   where
261     go :: [LHsDecl RdrName] -> [LHsDecl RdrName]
262     go []                   = []
263     go (L l (ValD b) : ds)  = L l' (ValD b') : go ds'
264                             where (L l' b', ds') = getMonoBind (L l b) ds
265     go (d : ds)             = d : go ds
266
267 -- Declaration list may only contain value bindings and signatures.
268 cvBindGroup :: OrdList (LHsDecl RdrName) -> HsValBinds RdrName
269 cvBindGroup binding
270   = case cvBindsAndSigs binding of
271       (mbs, sigs, tydecls, _) -> ASSERT( null tydecls )
272                                  ValBindsIn mbs sigs
273
274 cvBindsAndSigs :: OrdList (LHsDecl RdrName)
275   -> (Bag (LHsBind RdrName), [LSig RdrName], [LTyClDecl RdrName], [LDocDecl])
276 -- Input decls contain just value bindings and signatures
277 -- and in case of class or instance declarations also
278 -- associated type declarations. They might also contain Haddock comments.
279 cvBindsAndSigs  fb = go (fromOL fb)
280   where
281     go []                  = (emptyBag, [], [], [])
282     go (L l (SigD s) : ds) = (bs, L l s : ss, ts, docs)
283                            where (bs, ss, ts, docs) = go ds
284     go (L l (ValD b) : ds) = (b' `consBag` bs, ss, ts, docs)
285                            where (b', ds')    = getMonoBind (L l b) ds
286                                  (bs, ss, ts, docs) = go ds'
287     go (L l (TyClD t): ds) = (bs, ss, L l t : ts, docs)
288                            where (bs, ss, ts, docs) = go ds
289     go (L l (DocD d) : ds) =  (bs, ss, ts, (L l d) : docs)
290                            where (bs, ss, ts, docs) = go ds
291     go (L _ d : _)        = pprPanic "cvBindsAndSigs" (ppr d)
292
293 -----------------------------------------------------------------------------
294 -- Group function bindings into equation groups
295
296 getMonoBind :: LHsBind RdrName -> [LHsDecl RdrName]
297   -> (LHsBind RdrName, [LHsDecl RdrName])
298 -- Suppose      (b',ds') = getMonoBind b ds
299 --      ds is a list of parsed bindings
300 --      b is a MonoBinds that has just been read off the front
301
302 -- Then b' is the result of grouping more equations from ds that
303 -- belong with b into a single MonoBinds, and ds' is the depleted
304 -- list of parsed bindings.
305 --
306 -- All Haddock comments between equations inside the group are 
307 -- discarded.
308 --
309 -- No AndMonoBinds or EmptyMonoBinds here; just single equations
310
311 getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1), fun_infix = is_infix1,
312                                fun_matches = MatchGroup mtchs1 _ })) binds
313   | has_args mtchs1
314   = go is_infix1 mtchs1 loc1 binds []
315   where
316     go is_infix mtchs loc 
317        (L loc2 (ValD (FunBind { fun_id = L _ f2, fun_infix = is_infix2,
318                                 fun_matches = MatchGroup mtchs2 _ })) : binds) _
319         | f1 == f2 = go (is_infix || is_infix2) (mtchs2 ++ mtchs) 
320                         (combineSrcSpans loc loc2) binds []
321     go is_infix mtchs loc (doc_decl@(L loc2 (DocD _)) : binds) doc_decls 
322         = let doc_decls' = doc_decl : doc_decls  
323           in go is_infix mtchs (combineSrcSpans loc loc2) binds doc_decls'
324     go is_infix mtchs loc binds doc_decls
325         = (L loc (makeFunBind fun_id1 is_infix (reverse mtchs)), (reverse doc_decls) ++ binds)
326         -- Reverse the final matches, to get it back in the right order
327         -- Do the same thing with the trailing doc comments
328
329 getMonoBind bind binds = (bind, binds)
330
331 has_args :: [LMatch RdrName] -> Bool
332 has_args []                           = panic "RdrHsSyn:has_args"
333 has_args ((L _ (Match args _ _)) : _) = not (null args)
334         -- Don't group together FunBinds if they have
335         -- no arguments.  This is necessary now that variable bindings
336         -- with no arguments are now treated as FunBinds rather
337         -- than pattern bindings (tests/rename/should_fail/rnfail002).
338 \end{code}
339
340 %************************************************************************
341 %*                                                                      *
342 \subsection[PrefixToHS-utils]{Utilities for conversion}
343 %*                                                                      *
344 %************************************************************************
345
346
347 \begin{code}
348 -----------------------------------------------------------------------------
349 -- splitCon
350
351 -- When parsing data declarations, we sometimes inadvertently parse
352 -- a constructor application as a type (eg. in data T a b = C a b `D` E a b)
353 -- This function splits up the type application, adds any pending
354 -- arguments, and converts the type constructor back into a data constructor.
355
356 splitCon :: LHsType RdrName
357       -> P (Located RdrName, HsConDeclDetails RdrName)
358 -- This gets given a "type" that should look like
359 --      C Int Bool
360 -- or   C { x::Int, y::Bool }
361 -- and returns the pieces
362 splitCon ty
363  = split ty []
364  where
365    split (L _ (HsAppTy t u)) ts = split t (u : ts)
366    split (L l (HsTyVar tc))  ts = do data_con <- tyConToDataCon l tc
367                                      return (data_con, mk_rest ts)
368    split (L l _) _              = parseErrorSDoc l (text "parse error in constructor in data/newtype declaration:" <+> ppr ty)
369
370    mk_rest [L _ (HsRecTy flds)] = RecCon flds
371    mk_rest ts                   = PrefixCon ts
372
373 mkDeprecatedGadtRecordDecl :: SrcSpan 
374                            -> Located RdrName
375                            -> [ConDeclField RdrName]
376                            -> LHsType RdrName
377                            ->  P (LConDecl  RdrName)
378 -- This one uses the deprecated syntax
379 --    C { x,y ::Int } :: T a b
380 -- We give it a RecCon details right away
381 mkDeprecatedGadtRecordDecl loc (L con_loc con) flds res_ty
382   = do { data_con <- tyConToDataCon con_loc con
383        ; return (L loc (ConDecl { con_old_rec  = True
384                                 , con_name     = data_con
385                                 , con_explicit = Implicit
386                                 , con_qvars    = []
387                                 , con_cxt      = noLoc []
388                                 , con_details  = RecCon flds
389                                 , con_res      = ResTyGADT res_ty
390                                 , con_doc      = Nothing })) }
391
392 mkSimpleConDecl :: Located RdrName -> [LHsTyVarBndr RdrName]
393                 -> LHsContext RdrName -> HsConDeclDetails RdrName
394                 -> ConDecl RdrName
395
396 mkSimpleConDecl name qvars cxt details
397   = ConDecl { con_old_rec  = False
398             , con_name     = name
399             , con_explicit = Explicit
400             , con_qvars    = qvars
401             , con_cxt      = cxt
402             , con_details  = details
403             , con_res      = ResTyH98
404             , con_doc      = Nothing }
405
406 mkGadtDecl :: [Located RdrName]
407            -> LHsType RdrName     -- Always a HsForAllTy
408            -> [ConDecl RdrName]
409 -- We allow C,D :: ty
410 -- and expand it as if it had been 
411 --    C :: ty; D :: ty
412 -- (Just like type signatures in general.)
413 mkGadtDecl names (L _ (HsForAllTy imp qvars cxt tau))
414   = [mk_gadt_con name | name <- names]
415   where
416     (details, res_ty)           -- See Note [Sorting out the result type]
417       = case tau of
418           L _ (HsFunTy (L _ (HsRecTy flds)) res_ty) -> (RecCon flds,  res_ty)
419           _other                                    -> (PrefixCon [], tau)
420
421     mk_gadt_con name
422        = ConDecl { con_old_rec  = False
423                  , con_name     = name
424                  , con_explicit = imp
425                  , con_qvars    = qvars
426                  , con_cxt      = cxt
427                  , con_details  = details
428                  , con_res      = ResTyGADT res_ty
429                  , con_doc      = Nothing }
430 mkGadtDecl _ other_ty = pprPanic "mkGadtDecl" (ppr other_ty)
431
432 tyConToDataCon :: SrcSpan -> RdrName -> P (Located RdrName)
433 tyConToDataCon loc tc
434   | isTcOcc (rdrNameOcc tc)
435   = return (L loc (setRdrNameSpace tc srcDataName))
436   | otherwise
437   = parseErrorSDoc loc (msg $$ extra)
438   where
439     msg = text "Not a data constructor:" <+> quotes (ppr tc)
440     extra | tc == forall_tv_RDR
441           = text "Perhaps you intended to use -XExistentialQuantification"
442           | otherwise = empty
443 \end{code}
444
445 Note [Sorting out the result type]
446 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
447 In a GADT declaration which is not a record, we put the whole constr
448 type into the ResTyGADT for now; the renamer will unravel it once it
449 has sorted out operator fixities. Consider for example
450      C :: a :*: b -> a :*: b -> a :+: b
451 Initially this type will parse as
452       a :*: (b -> (a :*: (b -> (a :+: b))))
453
454 so it's hard to split up the arguments until we've done the precedence
455 resolution (in the renamer) On the other hand, for a record
456         { x,y :: Int } -> a :*: b
457 there is no doubt.  AND we need to sort records out so that
458 we can bring x,y into scope.  So:
459    * For PrefixCon we keep all the args in the ResTyGADT
460    * For RecCon we do not
461
462 \begin{code}
463 ----------------------------------------------------------------------------
464 -- Various Syntactic Checks
465
466 checkInstType :: LHsType RdrName -> P (LHsType RdrName)
467 checkInstType (L l t)
468   = case t of
469         HsForAllTy exp tvs ctxt ty -> do
470                 dict_ty <- checkDictTy ty
471                 return (L l (HsForAllTy exp tvs ctxt dict_ty))
472
473         HsParTy ty -> checkInstType ty
474
475         ty ->   do dict_ty <- checkDictTy (L l ty)
476                    return (L l (HsForAllTy Implicit [] (noLoc []) dict_ty))
477
478 checkDictTy :: LHsType RdrName -> P (LHsType RdrName)
479 checkDictTy (L spn ty) = check ty []
480   where
481   check (HsTyVar tc)            args | isRdrTc tc = done tc args
482   check (HsOpTy t1 (L _ tc) t2) args | isRdrTc tc = done tc (t1:t2:args)
483   check (HsAppTy l r) args = check (unLoc l) (r:args)
484   check (HsParTy t)   args = check (unLoc t) args
485   check _ _ = parseErrorSDoc spn (text "Malformed instance header:" <+> ppr ty)
486
487   done tc args = return (L spn (HsPredTy (HsClassP tc args)))
488
489 checkTParams :: Bool      -- Type/data family
490              -> [LHsType RdrName]
491              -> P ([LHsTyVarBndr RdrName], Maybe [LHsType RdrName])
492 -- checkTParams checks the type parameters of a data/newtype declaration
493 -- There are two cases:
494 --
495 --  a) Vanilla data/newtype decl. In that case 
496 --        - the type parameters should all be type variables
497 --        - they may have a kind annotation
498 --
499 --  b) Family data/newtype decl.  In that case
500 --        - The type parameters may be arbitrary types
501 --        - We find the type-varaible binders by find the 
502 --          free type vars of those types
503 --        - We make them all kind-sig-free binders (UserTyVar)
504 --          If there are kind sigs in the type parameters, they
505 --          will fix the binder's kind when we kind-check the 
506 --          type parameters
507 checkTParams is_family tparams
508   | not is_family        -- Vanilla case (a)
509   = do { tyvars <- checkTyVars tparams
510        ; return (tyvars, Nothing) }
511   | otherwise            -- Family case (b)
512   = do { let tyvars = userHsTyVarBndrs (extractHsTysRdrTyVars tparams)
513        ; return (tyvars, Just tparams) }
514
515 checkTyVars :: [LHsType RdrName] -> P [LHsTyVarBndr RdrName]
516 -- Check whether the given list of type parameters are all type variables
517 -- (possibly with a kind signature).  If the second argument is `False',
518 -- only type variables are allowed and we raise an error on encountering a
519 -- non-variable; otherwise, we allow non-variable arguments and return the
520 -- entire list of parameters.
521 checkTyVars tparms = mapM chk tparms
522   where
523         -- Check that the name space is correct!
524     chk (L l (HsKindSig (L _ (HsTyVar tv)) k))
525         | isRdrTyVar tv    = return (L l (KindedTyVar tv k))
526     chk (L l (HsTyVar tv))
527         | isRdrTyVar tv    = return (L l (UserTyVar tv placeHolderKind))
528     chk t@(L l _)            =
529           parseErrorSDoc l (text "Type found:" <+> ppr t
530                      $$ text "where type variable expected, in:" <+>
531                         sep (map (pprParendHsType . unLoc) tparms))
532
533 checkDatatypeContext :: Maybe (LHsContext RdrName) -> P ()
534 checkDatatypeContext Nothing = return ()
535 checkDatatypeContext (Just (L loc c))
536     = do allowed <- extension datatypeContextsEnabled
537          unless allowed $
538              parseErrorSDoc loc
539                  (text "Illegal datatype context (use -XDatatypeContexts):" <+>
540                   pprHsContext c)
541
542 checkTyClHdr :: LHsType RdrName
543              -> P (Located RdrName,          -- the head symbol (type or class name)
544                    [LHsType RdrName])        -- parameters of head symbol
545 -- Well-formedness check and decomposition of type and class heads.
546 -- Decomposes   T ty1 .. tyn   into    (T, [ty1, ..., tyn])
547 --              Int :*: Bool   into    (:*:, [Int, Bool])
548 -- returning the pieces
549 checkTyClHdr ty
550   = goL ty []
551   where
552     goL (L l ty) acc = go l ty acc
553
554     go l (HsTyVar tc) acc 
555         | isRdrTc tc         = return (L l tc, acc)
556                                      
557     go _ (HsOpTy t1 ltc@(L _ tc) t2) acc
558         | isRdrTc tc         = return (ltc, t1:t2:acc)
559     go _ (HsParTy ty)    acc = goL ty acc
560     go _ (HsAppTy t1 t2) acc = goL t1 (t2:acc)
561     go l _               _   = parseErrorSDoc l (text "Malformed head of type or class declaration:" <+> ppr ty)
562
563 -- Check that associated type declarations of a class are all kind signatures.
564 --
565 checkKindSigs :: [LTyClDecl RdrName] -> P ()
566 checkKindSigs = mapM_ check
567   where
568     check (L l tydecl) 
569       | isFamilyDecl tydecl
570         || isSynDecl tydecl  = return ()
571       | otherwise            = 
572         parseErrorSDoc l (text "Type declaration in a class must be a kind signature or synonym default:" $$ ppr tydecl)
573
574 checkContext :: LHsType RdrName -> P (LHsContext RdrName)
575 checkContext (L l t)
576   = check t
577  where
578   check (HsTupleTy _ ts)        -- (Eq a, Ord b) shows up as a tuple type
579     = do ctx <- mapM checkPred ts
580          return (L l ctx)
581
582   check (HsParTy ty)    -- to be sure HsParTy doesn't get into the way
583     = check (unLoc ty)
584
585   check (HsTyVar t)     -- Empty context shows up as a unit type ()
586     | t == getRdrName unitTyCon = return (L l [])
587
588   check t 
589     = do p <- checkPred (L l t)
590          return (L l [p])
591
592
593 checkPred :: LHsType RdrName -> P (LHsPred RdrName)
594 -- Watch out.. in ...deriving( Show )... we use checkPred on 
595 -- the list of partially applied predicates in the deriving,
596 -- so there can be zero args.
597 checkPred (L spn (HsPredTy (HsIParam n ty)))
598   = return (L spn (HsIParam n ty))
599 checkPred (L spn ty)
600   = check spn ty []
601   where
602     checkl (L l ty) args = check l ty args
603
604     check _loc (HsPredTy pred@(HsEqualP _ _)) 
605                                        args | null args
606                                             = return $ L spn pred
607     check _loc (HsTyVar t)             args | not (isRdrTyVar t) 
608                                             = return (L spn (HsClassP t args))
609     check _loc (HsAppTy l r)           args = checkl l (r:args)
610     check _loc (HsOpTy l (L loc tc) r) args = check loc (HsTyVar tc) (l:r:args)
611     check _loc (HsParTy t)             args = checkl t args
612     check loc _                        _    = parseErrorSDoc loc
613                                 (text "malformed class assertion:" <+> ppr ty)
614
615 ---------------------------------------------------------------------------
616 -- Checking statements in a do-expression
617 --      We parse   do { e1 ; e2 ; }
618 --      as [ExprStmt e1, ExprStmt e2]
619 -- checkDo (a) checks that the last thing is an ExprStmt
620 --         (b) returns it separately
621 -- same comments apply for mdo as well
622
623 checkDo, checkMDo :: SrcSpan -> [LStmt RdrName] -> P ([LStmt RdrName], LHsExpr RdrName)
624
625 checkDo  = checkDoMDo "a " "'do'"
626 checkMDo = checkDoMDo "an " "'mdo'"
627
628 checkDoMDo :: String -> String -> SrcSpan -> [LStmt RdrName] -> P ([LStmt RdrName], LHsExpr RdrName)
629 checkDoMDo _   nm loc []   = parseErrorSDoc loc (text ("Empty " ++ nm ++ " construct"))
630 checkDoMDo pre nm _   ss   = do
631   check ss
632   where 
633         check  []                     = panic "RdrHsSyn:checkDoMDo"
634         check  [L _ (ExprStmt e _ _)] = return ([], e)
635         check  [L l e] = parseErrorSDoc l
636                          (text ("The last statement in " ++ pre ++ nm ++
637                                                     " construct must be an expression:")
638                        $$ ppr e)
639         check (s:ss) = do
640           (ss',e') <-  check ss
641           return ((s:ss'),e')
642
643 -- -------------------------------------------------------------------------
644 -- Checking Patterns.
645
646 -- We parse patterns as expressions and check for valid patterns below,
647 -- converting the expression into a pattern at the same time.
648
649 checkPattern :: LHsExpr RdrName -> P (LPat RdrName)
650 checkPattern e = checkLPat e
651
652 checkPatterns :: [LHsExpr RdrName] -> P [LPat RdrName]
653 checkPatterns es = mapM checkPattern es
654
655 checkLPat :: LHsExpr RdrName -> P (LPat RdrName)
656 checkLPat e@(L l _) = checkPat l e []
657
658 checkPat :: SrcSpan -> LHsExpr RdrName -> [LPat RdrName] -> P (LPat RdrName)
659 checkPat loc (L l (HsVar c)) args
660   | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
661 checkPat loc e args     -- OK to let this happen even if bang-patterns
662                         -- are not enabled, because there is no valid
663                         -- non-bang-pattern parse of (C ! e)
664   | Just (e', args') <- splitBang e
665   = do  { args'' <- checkPatterns args'
666         ; checkPat loc e' (args'' ++ args) }
667 checkPat loc (L _ (HsApp f x)) args
668   = do { x <- checkLPat x; checkPat loc f (x:args) }
669 checkPat loc (L _ e) []
670   = do { pState <- getPState
671        ; p <- checkAPat (dflags pState) loc e
672        ; return (L loc p) }
673 checkPat loc e _
674   = patFail loc (unLoc e)
675
676 checkAPat :: DynFlags -> SrcSpan -> HsExpr RdrName -> P (Pat RdrName)
677 checkAPat dynflags loc e0 = case e0 of
678    EWildPat -> return (WildPat placeHolderType)
679    HsVar x  -> return (VarPat x)
680    HsLit l  -> return (LitPat l)
681
682    -- Overloaded numeric patterns (e.g. f 0 x = x)
683    -- Negation is recorded separately, so that the literal is zero or +ve
684    -- NB. Negative *primitive* literals are already handled by the lexer
685    HsOverLit pos_lit          -> return (mkNPat pos_lit Nothing)
686    NegApp (L _ (HsOverLit pos_lit)) _ 
687                         -> return (mkNPat pos_lit (Just noSyntaxExpr))
688    
689    SectionR (L _ (HsVar bang)) e        -- (! x)
690         | bang == bang_RDR 
691         -> do { bang_on <- extension bangPatEnabled
692               ; if bang_on then checkLPat e >>= (return . BangPat)
693                 else parseErrorSDoc loc (text "Illegal bang-pattern (use -XBangPatterns):" $$ ppr e0) }
694
695    ELazyPat e         -> checkLPat e >>= (return . LazyPat)
696    EAsPat n e         -> checkLPat e >>= (return . AsPat n)
697    -- view pattern is well-formed if the pattern is
698    EViewPat expr patE -> checkLPat patE >>= (return . (\p -> ViewPat expr p placeHolderType))
699    ExprWithTySig e t  -> do e <- checkLPat e
700                             -- Pattern signatures are parsed as sigtypes,
701                             -- but they aren't explicit forall points.  Hence
702                             -- we have to remove the implicit forall here.
703                             let t' = case t of 
704                                        L _ (HsForAllTy Implicit _ (L _ []) ty) -> ty
705                                        other -> other
706                             return (SigPatIn e t')
707    
708    -- n+k patterns
709    OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _ 
710          (L _ (HsOverLit lit@(OverLit {ol_val = HsIntegral {}})))
711                       | xopt Opt_NPlusKPatterns dynflags && (plus == plus_RDR)
712                       -> return (mkNPlusKPat (L nloc n) lit)
713    
714    OpApp l op _fix r  -> do l <- checkLPat l
715                             r <- checkLPat r
716                             case op of
717                                L cl (HsVar c) | isDataOcc (rdrNameOcc c)
718                                       -> return (ConPatIn (L cl c) (InfixCon l r))
719                                _ -> patFail loc e0
720    
721    HsPar e            -> checkLPat e >>= (return . ParPat)
722    ExplicitList _ es  -> do ps <- mapM checkLPat es
723                             return (ListPat ps placeHolderType)
724    ExplicitPArr _ es  -> do ps <- mapM checkLPat es
725                             return (PArrPat ps placeHolderType)
726    
727    ExplicitTuple es b 
728      | all tupArgPresent es  -> do ps <- mapM checkLPat [e | Present e <- es]
729                                    return (TuplePat ps b placeHolderType)
730      | otherwise -> parseErrorSDoc loc (text "Illegal tuple section in pattern:" $$ ppr e0)
731    
732    RecordCon c _ (HsRecFields fs dd)
733                       -> do fs <- mapM checkPatField fs
734                             return (ConPatIn c (RecCon (HsRecFields fs dd)))
735    HsQuasiQuoteE q    -> return (QuasiQuotePat q)
736 -- Generics 
737    HsType ty          -> return (TypePat ty) 
738    _                  -> patFail loc e0
739
740 placeHolderPunRhs :: LHsExpr RdrName
741 -- The RHS of a punned record field will be filled in by the renamer
742 -- It's better not to make it an error, in case we want to print it when debugging
743 placeHolderPunRhs = noLoc (HsVar pun_RDR)
744
745 plus_RDR, bang_RDR, pun_RDR :: RdrName
746 plus_RDR = mkUnqual varName (fsLit "+") -- Hack
747 bang_RDR = mkUnqual varName (fsLit "!") -- Hack
748 pun_RDR  = mkUnqual varName (fsLit "pun-right-hand-side")
749
750 checkPatField :: HsRecField RdrName (LHsExpr RdrName) -> P (HsRecField RdrName (LPat RdrName))
751 checkPatField fld = do  { p <- checkLPat (hsRecFieldArg fld)
752                         ; return (fld { hsRecFieldArg = p }) }
753
754 patFail :: SrcSpan -> HsExpr RdrName -> P a
755 patFail loc e = parseErrorSDoc loc (text "Parse error in pattern:" <+> ppr e)
756
757
758 ---------------------------------------------------------------------------
759 -- Check Equation Syntax
760
761 checkValDef :: LHsExpr RdrName
762             -> Maybe (LHsType RdrName)
763             -> Located (GRHSs RdrName)
764             -> P (HsBind RdrName)
765
766 checkValDef lhs (Just sig) grhss
767         -- x :: ty = rhs  parses as a *pattern* binding
768   = checkPatBind (L (combineLocs lhs sig) (ExprWithTySig lhs sig)) grhss
769
770 checkValDef lhs opt_sig grhss
771   = do  { mb_fun <- isFunLhs lhs
772         ; case mb_fun of
773             Just (fun, is_infix, pats) -> checkFunBind (getLoc lhs)
774                                                 fun is_infix pats opt_sig grhss
775             Nothing -> checkPatBind lhs grhss }
776
777 checkFunBind :: SrcSpan
778              -> Located RdrName
779              -> Bool
780              -> [LHsExpr RdrName]
781              -> Maybe (LHsType RdrName)
782              -> Located (GRHSs RdrName)
783              -> P (HsBind RdrName)
784 checkFunBind lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
785   = do  ps <- checkPatterns pats
786         let match_span = combineSrcSpans lhs_loc rhs_span
787         return (makeFunBind fun is_infix [L match_span (Match ps opt_sig grhss)])
788         -- The span of the match covers the entire equation.  
789         -- That isn't quite right, but it'll do for now.
790
791 makeFunBind :: Located id -> Bool -> [LMatch id] -> HsBind id
792 -- Like HsUtils.mkFunBind, but we need to be able to set the fixity too
793 makeFunBind fn is_infix ms 
794   = FunBind { fun_id = fn, fun_infix = is_infix, fun_matches = mkMatchGroup ms,
795               fun_co_fn = idHsWrapper, bind_fvs = placeHolderNames, fun_tick = Nothing }
796
797 checkPatBind :: LHsExpr RdrName
798              -> Located (GRHSs RdrName)
799              -> P (HsBind RdrName)
800 checkPatBind lhs (L _ grhss)
801   = do  { lhs <- checkPattern lhs
802         ; return (PatBind lhs grhss placeHolderType placeHolderNames) }
803
804 checkValSig
805         :: LHsExpr RdrName
806         -> LHsType RdrName
807         -> P (Sig RdrName)
808 checkValSig (L l (HsHetMetBrak _ e)) ty 
809   = checkValSig e ty
810 checkValSig (L l (HsVar v)) ty 
811   | isUnqual v && not (isDataOcc (rdrNameOcc v))
812   = return (TypeSig (L l v) ty)
813 checkValSig lhs@(L l _) ty
814   = parseErrorSDoc l ((text "Invalid type signature:" <+>
815                        ppr lhs <+> text "::" <+> ppr ty)
816                    $$ text hint)
817   where
818     hint = if looks_like_foreign lhs
819            then "Perhaps you meant to use -XForeignFunctionInterface?"
820            else "Should be of form <variable> :: <type>"
821     -- A common error is to forget the ForeignFunctionInterface flag
822     -- so check for that, and suggest.  cf Trac #3805
823     -- Sadly 'foreign import' still barfs 'parse error' because 'import' is a keyword
824     looks_like_foreign (L _ (HsVar v))     = v == foreign_RDR
825     looks_like_foreign (L _ (HsApp lhs _)) = looks_like_foreign lhs
826     looks_like_foreign _                   = False
827
828     foreign_RDR = mkUnqual varName (fsLit "foreign")
829
830 checkDoAndIfThenElse :: LHsExpr RdrName
831                      -> Bool
832                      -> LHsExpr RdrName
833                      -> Bool
834                      -> LHsExpr RdrName
835                      -> P ()
836 checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
837  | semiThen || semiElse
838     = do pState <- getPState
839          unless (xopt Opt_DoAndIfThenElse (dflags pState)) $ do
840              parseErrorSDoc (combineLocs guardExpr elseExpr)
841                             (text "Unexpected semi-colons in conditional:"
842                           $$ nest 4 expr
843                           $$ text "Perhaps you meant to use -XDoAndIfThenElse?")
844  | otherwise            = return ()
845     where pprOptSemi True  = semi
846           pprOptSemi False = empty
847           expr = text "if"   <+> ppr guardExpr <> pprOptSemi semiThen <+>
848                  text "then" <+> ppr thenExpr  <> pprOptSemi semiElse <+>
849                  text "else" <+> ppr elseExpr
850 \end{code}
851
852
853 \begin{code}
854         -- The parser left-associates, so there should 
855         -- not be any OpApps inside the e's
856 splitBang :: LHsExpr RdrName -> Maybe (LHsExpr RdrName, [LHsExpr RdrName])
857 -- Splits (f ! g a b) into (f, [(! g), a, b])
858 splitBang (L loc (OpApp l_arg bang@(L _ (HsVar op)) _ r_arg))
859   | op == bang_RDR = Just (l_arg, L loc (SectionR bang arg1) : argns)
860   where
861     (arg1,argns) = split_bang r_arg []
862     split_bang (L _ (HsApp f e)) es = split_bang f (e:es)
863     split_bang e                 es = (e,es)
864 splitBang _ = Nothing
865
866 isFunLhs :: LHsExpr RdrName 
867          -> P (Maybe (Located RdrName, Bool, [LHsExpr RdrName]))
868 -- A variable binding is parsed as a FunBind.
869 -- Just (fun, is_infix, arg_pats) if e is a function LHS
870 --
871 -- The whole LHS is parsed as a single expression.  
872 -- Any infix operators on the LHS will parse left-associatively
873 -- E.g.         f !x y !z
874 --      will parse (rather strangely) as 
875 --              (f ! x y) ! z
876 --      It's up to isFunLhs to sort out the mess
877 --
878 -- a .!. !b 
879
880 isFunLhs e = go e []
881  where
882    go (L loc (HsVar f)) es 
883         | not (isRdrDataCon f)   = return (Just (L loc f, False, es))
884    go (L _ (HsApp f e)) es       = go f (e:es)
885    go (L _ (HsPar e))   es@(_:_) = go e es
886
887         -- For infix function defns, there should be only one infix *function*
888         -- (though there may be infix *datacons* involved too).  So we don't
889         -- need fixity info to figure out which function is being defined.
890         --      a `K1` b `op` c `K2` d
891         -- must parse as
892         --      (a `K1` b) `op` (c `K2` d)
893         -- The renamer checks later that the precedences would yield such a parse.
894         -- 
895         -- There is a complication to deal with bang patterns.
896         --
897         -- ToDo: what about this?
898         --              x + 1 `op` y = ...
899
900    go e@(L loc (OpApp l (L loc' (HsVar op)) fix r)) es
901         | Just (e',es') <- splitBang e
902         = do { bang_on <- extension bangPatEnabled
903              ; if bang_on then go e' (es' ++ es)
904                else return (Just (L loc' op, True, (l:r:es))) }
905                 -- No bangs; behave just like the next case
906         | not (isRdrDataCon op)         -- We have found the function!
907         = return (Just (L loc' op, True, (l:r:es)))
908         | otherwise                     -- Infix data con; keep going
909         = do { mb_l <- go l es
910              ; case mb_l of
911                  Just (op', True, j : k : es')
912                     -> return (Just (op', True, j : op_app : es'))
913                     where
914                       op_app = L loc (OpApp k (L loc' (HsVar op)) fix r)
915                  _ -> return Nothing }
916    go _ _ = return Nothing
917
918 ---------------------------------------------------------------------------
919 -- Miscellaneous utilities
920
921 checkPrecP :: Located Int -> P Int
922 checkPrecP (L l i)
923  | 0 <= i && i <= maxPrecedence = return i
924  | otherwise
925     = parseErrorSDoc l (text ("Precedence out of range: " ++ show i))
926
927 mkRecConstrOrUpdate 
928         :: LHsExpr RdrName 
929         -> SrcSpan
930         -> ([HsRecField RdrName (LHsExpr RdrName)], Bool)
931         -> P (HsExpr RdrName)
932
933 mkRecConstrOrUpdate (L l (HsVar c)) _ (fs,dd) | isRdrDataCon c
934   = return (RecordCon (L l c) noPostTcExpr (mk_rec_fields fs dd))
935 mkRecConstrOrUpdate exp loc (fs,dd)
936   | null fs   = parseErrorSDoc loc (text "Empty record update of:" <+> ppr exp)
937   | otherwise = return (RecordUpd exp (mk_rec_fields fs dd) [] [] [])
938
939 mk_rec_fields :: [HsRecField id arg] -> Bool -> HsRecFields id arg
940 mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
941 mk_rec_fields fs True  = HsRecFields { rec_flds = fs, rec_dotdot = Just (length fs) }
942
943 mkInlinePragma :: (InlineSpec, RuleMatchInfo) -> Maybe Activation -> InlinePragma
944 -- The Maybe is because the user can omit the activation spec (and usually does)
945 mkInlinePragma (inl, match_info) mb_act
946   = InlinePragma { inl_inline = inl
947                  , inl_sat    = Nothing
948                  , inl_act    = act
949                  , inl_rule   = match_info }
950   where
951     act = case mb_act of
952             Just act -> act
953             Nothing  -> -- No phase specified
954                         case inl of
955                           NoInline -> NeverActive
956                           _other   -> AlwaysActive
957
958 -----------------------------------------------------------------------------
959 -- utilities for foreign declarations
960
961 -- construct a foreign import declaration
962 --
963 mkImport :: CCallConv
964          -> Safety 
965          -> (Located FastString, Located RdrName, LHsType RdrName) 
966          -> P (HsDecl RdrName)
967 mkImport cconv safety (L loc entity, v, ty)
968   | cconv == PrimCallConv                      = do
969   let funcTarget = CFunction (StaticTarget entity Nothing)
970       importSpec = CImport PrimCallConv safety nilFS funcTarget
971   return (ForD (ForeignImport v ty importSpec))
972
973   | otherwise = do
974     case parseCImport cconv safety (mkExtName (unLoc v)) (unpackFS entity) of
975       Nothing         -> parseErrorSDoc loc (text "Malformed entity string")
976       Just importSpec -> return (ForD (ForeignImport v ty importSpec))
977
978 -- the string "foo" is ambigous: either a header or a C identifier.  The
979 -- C identifier case comes first in the alternatives below, so we pick
980 -- that one.
981 parseCImport :: CCallConv -> Safety -> FastString -> String
982              -> Maybe ForeignImport
983 parseCImport cconv safety nm str =
984  listToMaybe $ map fst $ filter (null.snd) $ 
985      readP_to_S parse str
986  where
987    parse = do
988        skipSpaces
989        r <- choice [
990           string "dynamic" >> return (mk nilFS (CFunction DynamicTarget)),
991           string "wrapper" >> return (mk nilFS CWrapper),
992           optional (string "static" >> skipSpaces) >> 
993            (mk nilFS <$> cimp nm) +++
994            (do h <- munch1 hdr_char; skipSpaces; mk (mkFastString h) <$> cimp nm)
995          ]
996        skipSpaces
997        return r
998
999    mk = CImport cconv safety
1000
1001    hdr_char c = not (isSpace c) -- header files are filenames, which can contain
1002                                 -- pretty much any char (depending on the platform),
1003                                 -- so just accept any non-space character
1004    id_char  c = isAlphaNum c || c == '_'
1005
1006    cimp nm = (ReadP.char '&' >> skipSpaces >> CLabel <$> cid)
1007              +++ ((\c -> CFunction (StaticTarget c Nothing)) <$> cid)
1008           where 
1009             cid = return nm +++
1010                   (do c  <- satisfy (\c -> isAlpha c || c == '_')
1011                       cs <-  many (satisfy id_char)
1012                       return (mkFastString (c:cs)))
1013
1014
1015 -- construct a foreign export declaration
1016 --
1017 mkExport :: CCallConv
1018          -> (Located FastString, Located RdrName, LHsType RdrName) 
1019          -> P (HsDecl RdrName)
1020 mkExport cconv (L _ entity, v, ty) = return $
1021   ForD (ForeignExport v ty (CExport (CExportStatic entity' cconv)))
1022   where
1023     entity' | nullFS entity = mkExtName (unLoc v)
1024             | otherwise     = entity
1025
1026 -- Supplying the ext_name in a foreign decl is optional; if it
1027 -- isn't there, the Haskell name is assumed. Note that no transformation
1028 -- of the Haskell name is then performed, so if you foreign export (++),
1029 -- it's external name will be "++". Too bad; it's important because we don't
1030 -- want z-encoding (e.g. names with z's in them shouldn't be doubled)
1031 --
1032 mkExtName :: RdrName -> CLabelString
1033 mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm))
1034 \end{code}
1035
1036
1037 -----------------------------------------------------------------------------
1038 -- Misc utils
1039
1040 \begin{code}
1041 parseError :: SrcSpan -> String -> P a
1042 parseError span s = parseErrorSDoc span (text s)
1043
1044 parseErrorSDoc :: SrcSpan -> SDoc -> P a
1045 parseErrorSDoc span s = failSpanMsgP span s
1046 \end{code}