Fix the stage 1 build
[ghc-hetmet.git] / compiler / rename / RnPat.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[RnPat]{Renaming of patterns}
5
6 Basically dependency analysis.
7
8 Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In
9 general, all of these functions return a renamed thing, and a set of
10 free variables.
11
12 \begin{code}
13 module RnPat (-- main entry points
14               rnPatsAndThen_LocalRightwards, rnBindPat,
15
16               NameMaker, applyNameMaker,     -- a utility for making names:
17               localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,
18                                              --   sometimes we want to make top (qualified) names.
19
20               rnHsRecFields_Con, rnHsRecFields_Update, --rename record fields in a constructor
21                                                        --and in an update
22
23               -- Literals
24               rnLit, rnOverLit,     
25
26               -- Quasiquotation
27               rnQuasiQuote,
28
29              -- Pattern Error messages that are also used elsewhere
30              checkTupSize, patSigErr
31              ) where
32
33 -- ENH: thin imports to only what is necessary for patterns
34
35 import {-# SOURCE #-} RnExpr ( rnLExpr )
36 #ifdef GHCI
37 import {-# SOURCE #-} TcSplice ( runQuasiQuotePat )
38 #endif  /* GHCI */
39
40 #include "HsVersions.h"
41
42 import HsSyn            
43 import TcRnMonad
44 import RnEnv
45 import RnTypes
46 import DynFlags         ( DynFlag(..) )
47 import PrelNames
48 import Constants        ( mAX_TUPLE_SIZE )
49 import Name
50 import NameSet
51 import RdrName
52 import ListSetOps       ( removeDups, minusList )
53 import Outputable
54 import SrcLoc
55 import FastString
56 import Literal          ( inIntRange, inCharRange )
57 \end{code}
58
59
60 *********************************************************
61 *                                                       *
62 \subsection{Patterns}
63 *                                                       *
64 *********************************************************
65
66 \begin{code}
67 -- externally abstract type of name makers,
68 -- which is how you go from a RdrName to a Name
69 data NameMaker = NM (forall a. Located RdrName -> (Name -> RnM (a, FreeVars))
70                                                -> RnM (a, FreeVars))
71
72 matchNameMaker :: NameMaker
73 matchNameMaker
74   = NM (\ rdr_name thing_inside -> 
75         do { names@[name] <- newLocalsRn [rdr_name]
76            ; bindLocalNamesFV names $ do
77            { (res, fvs) <- thing_inside name
78            ; warnUnusedMatches names fvs
79            ; return (res, fvs) }})
80                           
81 topRecNameMaker, localRecNameMaker
82   :: MiniFixityEnv -> NameMaker
83
84 -- topNameMaker and localBindMaker do not check for unused binding
85 localRecNameMaker fix_env
86   = NM (\ rdr_name thing_inside -> 
87         do { [name] <- newLocalsRn [rdr_name]
88            ; bindLocalNamesFV_WithFixities [name] fix_env $
89              thing_inside name })
90   
91 topRecNameMaker fix_env
92   = NM (\rdr_name thing_inside -> 
93         do { mod <- getModule
94            ; name <- newTopSrcBinder mod rdr_name
95            ; bindLocalNamesFV_WithFixities [name] fix_env $
96              thing_inside name })
97                 -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious 
98                 --       because it binds a top-level name as a local name.
99                 --       however, this binding seems to work, and it only exists for
100                 --       the duration of the patterns and the continuation;
101                 --       then the top-level name is added to the global env
102                 --       before going on to the RHSes (see RnSource.lhs).
103
104 applyNameMaker :: NameMaker -> Located RdrName
105                -> (Name -> RnM (a,FreeVars)) -> RnM (a, FreeVars)
106 applyNameMaker (NM f) = f
107
108
109 -- There are various entry points to renaming patterns, depending on
110 --  (1) whether the names created should be top-level names or local names
111 --  (2) whether the scope of the names is entirely given in a continuation
112 --      (e.g., in a case or lambda, but not in a let or at the top-level,
113 --       because of the way mutually recursive bindings are handled)
114 --  (3) whether the a type signature in the pattern can bind 
115 --      lexically-scoped type variables (for unpacking existential 
116 --      type vars in data constructors)
117 --  (4) whether we do duplicate and unused variable checking
118 --  (5) whether there are fixity declarations associated with the names
119 --      bound by the patterns that need to be brought into scope with them.
120 --      
121 --  Rather than burdening the clients of this module with all of these choices,
122 --  we export the three points in this design space that we actually need:
123
124 -- entry point 1:
125 -- binds local names; the scope of the bindings is entirely in the thing_inside
126 --   allows type sigs to bind type vars
127 --   local namemaker
128 --   unused and duplicate checking
129 --   no fixities
130 rnPatsAndThen_LocalRightwards :: HsMatchContext Name -- for error messages
131                               -> [LPat RdrName] 
132                               -- the continuation gets:
133                               --    the list of renamed patterns
134                               --    the (overall) free vars of all of them
135                               -> ([LPat Name] -> RnM (a, FreeVars))
136                               -> RnM (a, FreeVars)
137
138 rnPatsAndThen_LocalRightwards ctxt pats thing_inside
139   = do  { envs_before <- getRdrEnvs
140
141           -- (0) bring into scope all of the type variables bound by the patterns
142           -- (1) rename the patterns, bringing into scope all of the term variables
143           -- (2) then do the thing inside.
144         ; bindPatSigTyVarsFV (collectSigTysFromPats pats) $ 
145           rnLPatsAndThen matchNameMaker pats    $ \ pats' ->
146             do { -- Check for duplicated and shadowed names 
147                  -- Because we don't bind the vars all at once, we can't
148                  --     check incrementally for duplicates; 
149                  -- Nor can we check incrementally for shadowing, else we'll
150                  --     complain *twice* about duplicates e.g. f (x,x) = ...
151             ; let names = collectPatsBinders pats'
152             ; checkDupNames doc_pat names
153             ; checkShadowedNames doc_pat envs_before
154                                  [(nameSrcSpan name, nameOccName name) | name <- names]
155             ; thing_inside pats' } }
156   where
157     doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
158
159
160 -- entry point 2:
161 -- binds local names; in a recursive scope that involves other bound vars
162 --      e.g let { (x, Just y) = e1; ... } in ...
163 --   does NOT allows type sig to bind type vars
164 --   local namemaker
165 --   no unused and duplicate checking
166 --   fixities might be coming in
167 rnBindPat :: NameMaker
168           -> LPat RdrName
169           -> RnM (LPat Name, 
170                        -- free variables of the pattern,
171                        -- but not including variables bound by this pattern 
172                    FreeVars)
173
174 rnBindPat name_maker pat
175   = rnLPatsAndThen name_maker [pat] $ \ [pat'] ->
176     return (pat', emptyFVs)
177
178
179 -- general version: parametrized by how you make new names
180 -- invariant: what-to-do continuation only gets called with a list whose length is the same as
181 --            the part of the pattern we're currently renaming
182 rnLPatsAndThen :: NameMaker -- how to make a new variable
183                -> [LPat RdrName]   -- part of pattern we're currently renaming
184                -> ([LPat Name] -> RnM (a, FreeVars)) -- what to do afterwards
185                -> RnM (a, FreeVars) -- renaming of the whole thing
186                
187 rnLPatsAndThen var = mapFvRnCPS (rnLPatAndThen var)
188
189
190 -- the workhorse
191 rnLPatAndThen :: NameMaker
192               -> LPat RdrName   -- part of pattern we're currently renaming
193               -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
194               -> RnM (a, FreeVars) -- renaming of the whole thing
195 rnLPatAndThen var@(NM varf) (L loc p) cont = 
196     setSrcSpan loc $ 
197       let reloc = L loc 
198           lcont = \ unlocated -> cont (reloc unlocated)
199       in
200        case p of
201          WildPat _   -> lcont (WildPat placeHolderType)
202
203          ParPat pat  -> rnLPatAndThen var pat $ \ pat' -> lcont (ParPat pat')
204          LazyPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (LazyPat pat')
205          BangPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (BangPat pat')
206          
207          VarPat name -> 
208             varf (reloc name) $ \ newBoundName -> 
209             lcont (VarPat newBoundName)
210                -- we need to bind pattern variables for view pattern expressions
211                -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
212                                      
213          SigPatIn pat ty -> do
214              patsigs <- doptM Opt_PatternSignatures
215              if patsigs
216               then rnLPatAndThen var pat
217                       (\ pat' -> do { (ty', fvs1) <- rnHsTypeFVs tvdoc ty
218                                     ; (res, fvs2) <- lcont (SigPatIn pat' ty')
219                                     ; return (res, fvs1 `plusFV` fvs2) })
220               else do addErr (patSigErr ty)
221                       rnLPatAndThen var pat cont
222            where
223              tvdoc = text "In a pattern type-signature"
224        
225          LitPat lit@(HsString s) -> 
226              do ovlStr <- doptM Opt_OverloadedStrings
227                 if ovlStr 
228                  then rnLPatAndThen var (reloc $ mkNPat (mkHsIsString s placeHolderType) Nothing) cont
229                  else do { rnLit lit; lcont (LitPat lit) }   -- Same as below
230       
231          LitPat lit -> do { rnLit lit; lcont (LitPat lit) }
232
233          NPat lit mb_neg _eq ->
234            do { (lit', fvs1) <- rnOverLit lit
235               ; (mb_neg', fvs2) <- case mb_neg of
236                                      Nothing -> return (Nothing, emptyFVs)
237                                      Just _  -> do { (neg, fvs) <- lookupSyntaxName negateName
238                                                    ; return (Just neg, fvs) }
239               ; (eq', fvs3) <- lookupSyntaxName eqName
240               ; (res, fvs4) <- lcont (NPat lit' mb_neg' eq')
241               ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
242                 -- Needed to find equality on pattern
243
244          NPlusKPat name lit _ _ ->
245            varf name $ \ new_name ->
246            do { (lit', fvs1) <- rnOverLit lit
247               ; (minus, fvs2) <- lookupSyntaxName minusName
248               ; (ge, fvs3) <- lookupSyntaxName geName
249               ; (res, fvs4) <- lcont (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus)
250               ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
251                 -- The Report says that n+k patterns must be in Integral
252
253          AsPat name pat ->
254            varf name $ \ new_name ->
255            rnLPatAndThen var pat $ \ pat' -> 
256            lcont (AsPat (L (nameSrcSpan new_name) new_name) pat')
257
258          ViewPat expr pat ty -> 
259            do { vp_flag <- doptM Opt_ViewPatterns
260               ; checkErr vp_flag (badViewPat p)
261                 -- because of the way we're arranging the recursive calls,
262                 -- this will be in the right context 
263               ; (expr', fv_expr) <- rnLExpr expr 
264               ; (res, fvs_res) <- rnLPatAndThen var pat $ \ pat' ->
265                                   lcont (ViewPat expr' pat' ty)
266               ; return (res, fvs_res `plusFV` fv_expr) }
267
268 #ifndef GHCI
269          (QuasiQuotePat _) -> pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
270 #else
271          QuasiQuotePat qq -> do
272              (qq', _) <- rnQuasiQuote qq
273              pat' <- runQuasiQuotePat qq'
274              rnLPatAndThen var pat' $ \ (L _ pat'') ->
275                  lcont pat''
276 #endif  /* GHCI */
277
278          ConPatIn con stuff -> 
279              -- rnConPatAndThen takes care of reconstructing the pattern
280              rnConPatAndThen var con stuff cont
281
282          ListPat pats _ -> 
283            rnLPatsAndThen var pats $ \ patslist ->
284                lcont (ListPat patslist placeHolderType)
285
286          PArrPat pats _ -> 
287            do { (res, res_fvs) <- rnLPatsAndThen var pats $ \ patslist ->
288                                   lcont (PArrPat patslist placeHolderType)
289               ; return (res, res_fvs `plusFV` implicit_fvs) }
290            where
291              implicit_fvs = mkFVs [lengthPName, indexPName]
292
293          TuplePat pats boxed _ -> 
294            do { checkTupSize (length pats)
295               ; rnLPatsAndThen var pats $ \ patslist ->
296                 lcont (TuplePat patslist boxed placeHolderType) }
297
298          TypePat name -> 
299            do { (name', fvs1) <- rnHsTypeFVs (text "In a type pattern") name
300               ; (res, fvs2) <- lcont (TypePat name')
301               ; return (res, fvs1 `plusFV` fvs2) }
302
303          p -> pprPanic "rnLPatAndThen" (ppr p)
304
305
306 -- helper for renaming constructor patterns
307 rnConPatAndThen :: NameMaker
308                 -> Located RdrName          -- the constructor
309                 -> HsConPatDetails RdrName 
310                 -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
311                 -> RnM (a, FreeVars)
312
313 rnConPatAndThen var (con@(L loc _)) (PrefixCon pats) cont
314   = do  { con' <- lookupLocatedOccRn con
315         ; (res, res_fvs) <- rnLPatsAndThen var pats $ \ pats' ->
316                             cont (L loc $ ConPatIn con' (PrefixCon pats'))
317         ; return (res, res_fvs `addOneFV` unLoc con') }
318
319 rnConPatAndThen var (con@(L loc _)) (InfixCon pat1 pat2) cont
320   = do  { con' <- lookupLocatedOccRn con
321         ; (res, res_fvs) <- rnLPatAndThen var pat1 $ \ pat1' -> 
322                             rnLPatAndThen var pat2 $ \ pat2' ->
323                             do { fixity <- lookupFixityRn (unLoc con')
324                                ; pat' <- mkConOpPatRn con' fixity pat1' pat2'
325                                ; cont (L loc pat') }
326         ; return (res, res_fvs `addOneFV` unLoc con') }
327
328 rnConPatAndThen var (con@(L loc _)) (RecCon rpats) cont
329   = do  { con' <- lookupLocatedOccRn con
330         ; (res, res_fvs) <- rnHsRecFieldsAndThen_Pattern con' var rpats $ \ rpats' -> 
331                             cont (L loc $ ConPatIn con' (RecCon rpats'))
332         ; return (res, res_fvs `addOneFV` unLoc con') }
333
334 -- what kind of record expression we're doing
335 -- the first two tell the name of the datatype constructor in question
336 -- and give a way of creating a variable to fill in a ..
337 data RnHsRecFieldsChoice a = Constructor (Located Name) (RdrName -> a)
338                            | Pattern  (Located Name) (RdrName -> a)
339                            | Update
340
341 choiceToMessage :: RnHsRecFieldsChoice t -> String
342 choiceToMessage (Constructor _ _) = "construction"
343 choiceToMessage (Pattern _ _) = "pattern"
344 choiceToMessage Update = "update"
345
346 doDotDot :: RnHsRecFieldsChoice t -> Maybe (Located Name, RdrName -> t)
347 doDotDot (Constructor a b) = Just (a,b)
348 doDotDot (Pattern a b) = Just (a,b)
349 doDotDot Update        = Nothing
350
351 getChoiceName :: RnHsRecFieldsChoice field -> Maybe (Located Name)
352 getChoiceName (Constructor n _) = Just n
353 getChoiceName (Pattern n _) = Just n
354 getChoiceName (Update) = Nothing
355
356
357
358 -- helper for renaming record patterns;
359 -- parameterized so that it can also be used for expressions
360 rnHsRecFieldsAndThen :: RnHsRecFieldsChoice field
361                      -- how to rename the fields (CPSed)
362                      -> (Located field -> (Located field' -> RnM (c, FreeVars)) 
363                                        -> RnM (c, FreeVars)) 
364                      -- the actual fields 
365                      -> HsRecFields RdrName (Located field)  
366                      -- what to do in the scope of the field vars
367                      -> (HsRecFields Name (Located field') -> RnM (c, FreeVars)) 
368                      -> RnM (c, FreeVars)
369 -- Haddock comments for record fields are renamed to Nothing here
370 rnHsRecFieldsAndThen choice rn_thing (HsRecFields fields dd) cont = 
371     let
372
373         -- helper to collect and report duplicate record fields
374         reportDuplicateFields doingstr fields = 
375             let 
376                 -- each list represents a RdrName that occurred more than once
377                 -- (the list contains all occurrences)
378                 -- invariant: each list in dup_fields is non-empty
379                 dup_fields :: [[RdrName]]
380                 (_, dup_fields) = removeDups compare
381                                                  (map (unLoc . hsRecFieldId) fields)
382                                              
383                 -- duplicate field reporting function
384                 field_dup_err dup_group = addErr (dupFieldErr doingstr (head dup_group))
385             in
386               mapM_ field_dup_err dup_fields
387
388         -- helper to rename each field
389         rn_field pun_ok (HsRecField field inside pun) cont = do 
390           fieldname <- lookupRecordBndr (getChoiceName choice) field
391           checkErr (not pun || pun_ok) (badPun field)
392           (res, res_fvs) <- rn_thing inside $ \ inside' -> 
393                             cont (HsRecField fieldname inside' pun) 
394           return (res, res_fvs `addOneFV` unLoc fieldname)
395
396         -- Compute the extra fields to be filled in by the dot-dot notation
397         dot_dot_fields fs con mk_field cont = do 
398             con_fields <- lookupConstructorFields (unLoc con)
399             let missing_fields = con_fields `minusList` fs
400             loc <- getSrcSpanM  -- Rather approximate
401             -- it's important that we make the RdrName fields that we morally wrote
402             -- and then rename them in the usual manner
403             -- (rather than trying to make the result of renaming directly)
404             -- because, for patterns, renaming can bind vars in the continuation
405             mapFvRnCPS rn_thing 
406              (map (L loc . mk_field . mkRdrUnqual . getOccName) missing_fields) $
407               \ rhss -> 
408                   let new_fs = [ HsRecField (L loc f) r False
409                                  | (f, r) <- missing_fields `zip` rhss ]
410                   in 
411                   cont new_fs
412
413    in do
414        -- report duplicate fields
415        let doingstr = choiceToMessage choice
416        reportDuplicateFields doingstr fields
417
418        -- rename the records as written
419        -- check whether punning (implicit x=x) is allowed
420        pun_flag <- doptM Opt_RecordPuns
421        -- rename the fields
422        mapFvRnCPS (rn_field pun_flag) fields $ \ fields1 ->
423
424            -- handle ..
425            case dd of
426              Nothing -> cont (HsRecFields fields1 dd)
427              Just n  -> ASSERT( n == length fields ) do
428                           dd_flag <- doptM Opt_RecordWildCards
429                           checkErr dd_flag (needFlagDotDot doingstr)
430                           let fld_names1 = map (unLoc . hsRecFieldId) fields1
431                           case doDotDot choice of 
432                                 Nothing -> do addErr (badDotDot doingstr)
433                                               -- we return a junk value here so that error reporting goes on
434                                               cont (HsRecFields fields1 dd)
435                                 Just (con, mk_field) ->
436                                     dot_dot_fields fld_names1 con mk_field $
437                                       \ fields2 -> 
438                                           cont (HsRecFields (fields1 ++ fields2) dd)
439
440 needFlagDotDot :: String -> SDoc
441 needFlagDotDot str = vcat [ptext (sLit "Illegal `..' in record") <+> text str,
442                           ptext (sLit "Use -XRecordWildCards to permit this")]
443
444 badDotDot :: String -> SDoc
445 badDotDot str = ptext (sLit "You cannot use `..' in record") <+> text str
446
447 badPun :: Located RdrName -> SDoc
448 badPun fld = vcat [ptext (sLit "Illegal use of punning for field") <+> quotes (ppr fld),
449                    ptext (sLit "Use -XRecordPuns to permit this")]
450
451
452 -- wrappers
453 rnHsRecFieldsAndThen_Pattern :: Located Name
454                              -> NameMaker -- new name maker
455                              -> HsRecFields RdrName (LPat RdrName)  
456                              -> (HsRecFields Name (LPat Name) -> RnM (c, FreeVars)) 
457                              -> RnM (c, FreeVars)
458 rnHsRecFieldsAndThen_Pattern n var
459   = rnHsRecFieldsAndThen (Pattern n VarPat) (rnLPatAndThen var)
460
461
462 -- wrapper to use rnLExpr in CPS style;
463 -- because it does not bind any vars going forward, it does not need
464 -- to be written that way
465 rnLExprAndThen :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
466                -> LHsExpr RdrName 
467                -> (LHsExpr Name -> RnM (c, FreeVars)) 
468                -> RnM (c, FreeVars) 
469 rnLExprAndThen f e cont = do { (x, fvs1) <- f e
470                              ; (res, fvs2) <- cont x
471                              ; return (res, fvs1 `plusFV` fvs2) }
472
473
474 -- non-CPSed because exprs don't leave anything bound
475 rnHsRecFields_Con :: Located Name
476                   -> (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
477                   -> HsRecFields RdrName (LHsExpr RdrName)  
478                   -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
479 rnHsRecFields_Con n rnLExpr fields = rnHsRecFieldsAndThen (Constructor n HsVar) 
480                                      (rnLExprAndThen rnLExpr) fields $ \ res ->
481                                      return (res, emptyFVs)
482
483 rnHsRecFields_Update :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
484                      -> HsRecFields RdrName (LHsExpr RdrName)  
485                      -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
486 rnHsRecFields_Update rnLExpr fields = rnHsRecFieldsAndThen Update
487                                       (rnLExprAndThen rnLExpr) fields $ \ res -> 
488                                       return (res, emptyFVs)
489 \end{code}
490
491
492
493 %************************************************************************
494 %*                                                                      *
495 \subsubsection{Literals}
496 %*                                                                      *
497 %************************************************************************
498
499 When literals occur we have to make sure
500 that the types and classes they involve
501 are made available.
502
503 \begin{code}
504 rnLit :: HsLit -> RnM ()
505 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
506 rnLit _ = return ()
507
508 rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars)
509 rnOverLit (HsIntegral i _ _) = do
510     (from_integer_name, fvs) <- lookupSyntaxName fromIntegerName
511     if inIntRange i then
512         return (HsIntegral i from_integer_name placeHolderType, fvs)
513      else let
514         extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
515         -- Big integer literals are built, using + and *, 
516         -- out of small integers (DsUtils.mkIntegerLit)
517         -- [NB: plusInteger, timesInteger aren't rebindable... 
518         --      they are used to construct the argument to fromInteger, 
519         --      which is the rebindable one.]
520         in
521         return (HsIntegral i from_integer_name placeHolderType, fvs `plusFV` extra_fvs)
522
523 rnOverLit (HsFractional i _ _) = do
524     (from_rat_name, fvs) <- lookupSyntaxName fromRationalName
525     let
526         extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
527         -- We have to make sure that the Ratio type is imported with
528         -- its constructor, because literals of type Ratio t are
529         -- built with that constructor.
530         -- The Rational type is needed too, but that will come in
531         -- as part of the type for fromRational.
532         -- The plus/times integer operations may be needed to construct the numerator
533         -- and denominator (see DsUtils.mkIntegerLit)
534     return (HsFractional i from_rat_name placeHolderType, fvs `plusFV` extra_fvs)
535
536 rnOverLit (HsIsString s _ _) = do
537     (from_string_name, fvs) <- lookupSyntaxName fromStringName
538     return (HsIsString s from_string_name placeHolderType, fvs)
539 \end{code}
540
541 %************************************************************************
542 %*                                                                      *
543 \subsubsection{Quasiquotation}
544 %*                                                                      *
545 %************************************************************************
546
547 See Note [Quasi-quote overview] in TcSplice.
548
549 \begin{code}
550 rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
551 rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
552   = do  { loc  <- getSrcSpanM
553         ; [n'] <- newLocalsRn [L loc n]
554         ; quoter' <-  (lookupOccRn quoter)
555                 -- If 'quoter' is not in scope, proceed no further
556                 -- Otherwise lookupOcc adds an error messsage and returns 
557                 -- an "unubound name", which makes the subsequent attempt to
558                 -- run the quote fail
559         ; return (HsQuasiQuote n' quoter' quoteSpan quote, unitFV quoter') }
560 \end{code}
561
562 %************************************************************************
563 %*                                                                      *
564 \subsubsection{Errors}
565 %*                                                                      *
566 %************************************************************************
567
568 \begin{code}
569 checkTupSize :: Int -> RnM ()
570 checkTupSize tup_size
571   | tup_size <= mAX_TUPLE_SIZE 
572   = return ()
573   | otherwise                  
574   = addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),
575                  nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)),
576                  nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))])
577
578 patSigErr :: Outputable a => a -> SDoc
579 patSigErr ty
580   =  (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)
581         $$ nest 4 (ptext (sLit "Use -XPatternSignatures to permit it"))
582
583 dupFieldErr :: String -> RdrName -> SDoc
584 dupFieldErr str dup
585   = hsep [ptext (sLit "duplicate field name"), 
586           quotes (ppr dup),
587           ptext (sLit "in record"), text str]
588
589 bogusCharError :: Char -> SDoc
590 bogusCharError c
591   = ptext (sLit "character literal out of range: '\\") <> char c  <> char '\''
592
593 badViewPat :: Pat RdrName -> SDoc
594 badViewPat pat = vcat [ptext (sLit "Illegal view pattern: ") <+> ppr pat,
595                        ptext (sLit "Use -XViewPatterns to enable view patterns")]
596
597 \end{code}