96cb1aa4fd54c4b067d1e9573a6514bc071c68af
[ghc.git] / compiler / rename / RnBinds.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[RnBinds]{Renaming and dependency analysis of bindings}
5
6 This module does renaming and dependency analysis on value bindings in
7 the abstract syntax.  It does {\em not} do cycle-checks on class or
8 type-synonym declarations; those cannot be done at this stage because
9 they may be affected by renaming (which isn't fully worked out yet).
10
11 \begin{code}
12 {-# LANGUAGE CPP #-}
13
14 module RnBinds (
15    -- Renaming top-level bindings
16    rnTopBindsLHS, rnTopBindsRHS, rnValBindsRHS,
17
18    -- Renaming local bindings
19    rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
20
21    -- Other bindings
22    rnMethodBinds, renameSigs, mkSigTvFn,
23    rnMatchGroup, rnGRHSs, rnGRHS,
24    makeMiniFixityEnv, MiniFixityEnv,
25    HsSigCtxt(..)
26    ) where
27
28 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )
29
30 import HsSyn
31 import TcRnMonad
32 import TcEvidence     ( emptyTcEvBinds )
33 import RnTypes        ( bindSigTyVarsFV, rnHsSigType, rnLHsType, checkPrecMatch, rnContext )
34 import RnPat
35 import RnNames
36 import RnEnv
37 import DynFlags
38 import Module
39 import Name
40 import NameEnv
41 import NameSet
42 import RdrName          ( RdrName, rdrNameOcc )
43 import SrcLoc
44 import ListSetOps       ( findDupsEq )
45 import BasicTypes       ( RecFlag(..) )
46 import Digraph          ( SCC(..) )
47 import Bag
48 import Outputable
49 import FastString
50 import Data.List        ( partition, sort )
51 import Maybes           ( orElse )
52 import Control.Monad
53 #if __GLASGOW_HASKELL__ < 709
54 import Data.Traversable ( traverse )
55 #endif
56 \end{code}
57
58 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
59 -- place and can be used when complaining.
60
61 The code tree received by the function @rnBinds@ contains definitions
62 in where-clauses which are all apparently mutually recursive, but which may
63 not really depend upon each other. For example, in the top level program
64 \begin{verbatim}
65 f x = y where a = x
66               y = x
67 \end{verbatim}
68 the definitions of @a@ and @y@ do not depend on each other at all.
69 Unfortunately, the typechecker cannot always check such definitions.
70 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
71 definitions. In Proceedings of the International Symposium on Programming,
72 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
73 However, the typechecker usually can check definitions in which only the
74 strongly connected components have been collected into recursive bindings.
75 This is precisely what the function @rnBinds@ does.
76
77 ToDo: deal with case where a single monobinds binds the same variable
78 twice.
79
80 The vertag tag is a unique @Int@; the tags only need to be unique
81 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
82 (heavy monad machinery not needed).
83
84
85 %************************************************************************
86 %*                                                                      *
87 %* naming conventions                                                   *
88 %*                                                                      *
89 %************************************************************************
90
91 \subsection[name-conventions]{Name conventions}
92
93 The basic algorithm involves walking over the tree and returning a tuple
94 containing the new tree plus its free variables. Some functions, such
95 as those walking polymorphic bindings (HsBinds) and qualifier lists in
96 list comprehensions (@Quals@), return the variables bound in local
97 environments. These are then used to calculate the free variables of the
98 expression evaluated in these environments.
99
100 Conventions for variable names are as follows:
101 \begin{itemize}
102 \item
103 new code is given a prime to distinguish it from the old.
104
105 \item
106 a set of variables defined in @Exp@ is written @dvExp@
107
108 \item
109 a set of variables free in @Exp@ is written @fvExp@
110 \end{itemize}
111
112 %************************************************************************
113 %*                                                                      *
114 %* analysing polymorphic bindings (HsBindGroup, HsBind)
115 %*                                                                      *
116 %************************************************************************
117
118 \subsubsection[dep-HsBinds]{Polymorphic bindings}
119
120 Non-recursive expressions are reconstructed without any changes at top
121 level, although their component expressions may have to be altered.
122 However, non-recursive expressions are currently not expected as
123 \Haskell{} programs, and this code should not be executed.
124
125 Monomorphic bindings contain information that is returned in a tuple
126 (a @FlatMonoBinds@) containing:
127
128 \begin{enumerate}
129 \item
130 a unique @Int@ that serves as the ``vertex tag'' for this binding.
131
132 \item
133 the name of a function or the names in a pattern. These are a set
134 referred to as @dvLhs@, the defined variables of the left hand side.
135
136 \item
137 the free variables of the body. These are referred to as @fvBody@.
138
139 \item
140 the definition's actual code. This is referred to as just @code@.
141 \end{enumerate}
142
143 The function @nonRecDvFv@ returns two sets of variables. The first is
144 the set of variables defined in the set of monomorphic bindings, while the
145 second is the set of free variables in those bindings.
146
147 The set of variables defined in a non-recursive binding is just the
148 union of all of them, as @union@ removes duplicates. However, the
149 free variables in each successive set of cumulative bindings is the
150 union of those in the previous set plus those of the newest binding after
151 the defined variables of the previous set have been removed.
152
153 @rnMethodBinds@ deals only with the declarations in class and
154 instance declarations.  It expects only to see @FunMonoBind@s, and
155 it expects the global environment to contain bindings for the binders
156 (which are all class operations).
157
158 %************************************************************************
159 %*                                                                      *
160 \subsubsection{ Top-level bindings}
161 %*                                                                      *
162 %************************************************************************
163
164 \begin{code}
165 -- for top-level bindings, we need to make top-level names,
166 -- so we have a different entry point than for local bindings
167 rnTopBindsLHS :: MiniFixityEnv
168               -> HsValBinds RdrName
169               -> RnM (HsValBindsLR Name RdrName)
170 rnTopBindsLHS fix_env binds
171   = rnValBindsLHS (topRecNameMaker fix_env) binds
172
173 rnTopBindsRHS :: NameSet -> HsValBindsLR Name RdrName
174               -> RnM (HsValBinds Name, DefUses)
175 rnTopBindsRHS bound_names binds
176   = do { is_boot <- tcIsHsBootOrSig
177        ; if is_boot
178          then rnTopBindsBoot binds
179          else rnValBindsRHS (TopSigCtxt bound_names False) binds }
180
181 rnTopBindsBoot :: HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)
182 -- A hs-boot file has no bindings.
183 -- Return a single HsBindGroup with empty binds and renamed signatures
184 rnTopBindsBoot (ValBindsIn mbinds sigs)
185   = do  { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
186         ; (sigs', fvs) <- renameSigs HsBootCtxt sigs
187         ; return (ValBindsOut [] sigs', usesOnly fvs) }
188 rnTopBindsBoot b = pprPanic "rnTopBindsBoot" (ppr b)
189 \end{code}
190
191
192 %*********************************************************
193 %*                                                      *
194                 HsLocalBinds
195 %*                                                      *
196 %*********************************************************
197
198 \begin{code}
199 rnLocalBindsAndThen :: HsLocalBinds RdrName
200                     -> (HsLocalBinds Name -> RnM (result, FreeVars))
201                     -> RnM (result, FreeVars)
202 -- This version (a) assumes that the binding vars are *not* already in scope
203 --               (b) removes the binders from the free vars of the thing inside
204 -- The parser doesn't produce ThenBinds
205 rnLocalBindsAndThen EmptyLocalBinds thing_inside
206   = thing_inside EmptyLocalBinds
207
208 rnLocalBindsAndThen (HsValBinds val_binds) thing_inside
209   = rnLocalValBindsAndThen val_binds $ \ val_binds' ->
210       thing_inside (HsValBinds val_binds')
211
212 rnLocalBindsAndThen (HsIPBinds binds) thing_inside = do
213     (binds',fv_binds) <- rnIPBinds binds
214     (thing, fvs_thing) <- thing_inside (HsIPBinds binds')
215     return (thing, fvs_thing `plusFV` fv_binds)
216
217 rnIPBinds :: HsIPBinds RdrName -> RnM (HsIPBinds Name, FreeVars)
218 rnIPBinds (IPBinds ip_binds _no_dict_binds) = do
219     (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
220     return (IPBinds ip_binds' emptyTcEvBinds, plusFVs fvs_s)
221
222 rnIPBind :: IPBind RdrName -> RnM (IPBind Name, FreeVars)
223 rnIPBind (IPBind ~(Left n) expr) = do
224     (expr',fvExpr) <- rnLExpr expr
225     return (IPBind (Left n) expr', fvExpr)
226 \end{code}
227
228
229 %************************************************************************
230 %*                                                                      *
231                 ValBinds
232 %*                                                                      *
233 %************************************************************************
234
235 \begin{code}
236 -- Renaming local binding groups
237 -- Does duplicate/shadow check
238 rnLocalValBindsLHS :: MiniFixityEnv
239                    -> HsValBinds RdrName
240                    -> RnM ([Name], HsValBindsLR Name RdrName)
241 rnLocalValBindsLHS fix_env binds
242   = do { binds' <- rnValBindsLHS (localRecNameMaker fix_env) binds
243
244          -- Check for duplicates and shadowing
245          -- Must do this *after* renaming the patterns
246          -- See Note [Collect binders only after renaming] in HsUtils
247
248          -- We need to check for dups here because we
249          -- don't don't bind all of the variables from the ValBinds at once
250          -- with bindLocatedLocals any more.
251          --
252          -- Note that we don't want to do this at the top level, since
253          -- sorting out duplicates and shadowing there happens elsewhere.
254          -- The behavior is even different. For example,
255          --   import A(f)
256          --   f = ...
257          -- should not produce a shadowing warning (but it will produce
258          -- an ambiguity warning if you use f), but
259          --   import A(f)
260          --   g = let f = ... in f
261          -- should.
262        ; let bound_names = collectHsValBinders binds'
263        ; envs <- getRdrEnvs
264        ; checkDupAndShadowedNames envs bound_names
265
266        ; return (bound_names, binds') }
267
268 -- renames the left-hand sides
269 -- generic version used both at the top level and for local binds
270 -- does some error checking, but not what gets done elsewhere at the top level
271 rnValBindsLHS :: NameMaker
272               -> HsValBinds RdrName
273               -> RnM (HsValBindsLR Name RdrName)
274 rnValBindsLHS topP (ValBindsIn mbinds sigs)
275   = do { mbinds' <- mapBagM (wrapLocM (rnBindLHS topP doc)) mbinds
276        ; return $ ValBindsIn mbinds' sigs }
277   where
278     bndrs = collectHsBindsBinders mbinds
279     doc   = text "In the binding group for:" <+> pprWithCommas ppr bndrs
280
281 rnValBindsLHS _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)
282
283 -- General version used both from the top-level and for local things
284 -- Assumes the LHS vars are in scope
285 --
286 -- Does not bind the local fixity declarations
287 rnValBindsRHS :: HsSigCtxt
288               -> HsValBindsLR Name RdrName
289               -> RnM (HsValBinds Name, DefUses)
290
291 rnValBindsRHS ctxt (ValBindsIn mbinds sigs)
292   = do { (sigs', sig_fvs) <- renameSigs ctxt sigs
293        ; binds_w_dus <- mapBagM (rnLBind (mkSigTvFn sigs')) mbinds
294        ; case depAnalBinds binds_w_dus of
295            (anal_binds, anal_dus) -> return (valbind', valbind'_dus)
296               where
297                 valbind' = ValBindsOut anal_binds sigs'
298                 valbind'_dus = anal_dus `plusDU` usesOnly sig_fvs
299                                -- Put the sig uses *after* the bindings
300                                -- so that the binders are removed from
301                                -- the uses in the sigs
302        }
303
304 rnValBindsRHS _ b = pprPanic "rnValBindsRHS" (ppr b)
305
306 -- Wrapper for local binds
307 --
308 -- The *client* of this function is responsible for checking for unused binders;
309 -- it doesn't (and can't: we don't have the thing inside the binds) happen here
310 --
311 -- The client is also responsible for bringing the fixities into scope
312 rnLocalValBindsRHS :: NameSet  -- names bound by the LHSes
313                    -> HsValBindsLR Name RdrName
314                    -> RnM (HsValBinds Name, DefUses)
315 rnLocalValBindsRHS bound_names binds
316   = rnValBindsRHS (LocalBindCtxt bound_names) binds
317
318 -- for local binds
319 -- wrapper that does both the left- and right-hand sides
320 --
321 -- here there are no local fixity decls passed in;
322 -- the local fixity decls come from the ValBinds sigs
323 rnLocalValBindsAndThen :: HsValBinds RdrName
324                        -> (HsValBinds Name -> RnM (result, FreeVars))
325                        -> RnM (result, FreeVars)
326 rnLocalValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
327  = do   {     -- (A) Create the local fixity environment
328           new_fixities <- makeMiniFixityEnv [L loc sig
329                                                   | L loc (FixSig sig) <- sigs]
330
331               -- (B) Rename the LHSes
332         ; (bound_names, new_lhs) <- rnLocalValBindsLHS new_fixities binds
333
334               --     ...and bring them (and their fixities) into scope
335         ; bindLocalNamesFV bound_names              $
336           addLocalFixities new_fixities bound_names $ do
337
338         {      -- (C) Do the RHS and thing inside
339           (binds', dus) <- rnLocalValBindsRHS (mkNameSet bound_names) new_lhs
340         ; (result, result_fvs) <- thing_inside binds'
341
342                 -- Report unused bindings based on the (accurate)
343                 -- findUses.  E.g.
344                 --      let x = x in 3
345                 -- should report 'x' unused
346         ; let real_uses = findUses dus result_fvs
347               -- Insert fake uses for variables introduced implicitly by
348               -- wildcards (#4404)
349               implicit_uses = hsValBindsImplicits binds'
350         ; warnUnusedLocalBinds bound_names
351                                       (real_uses `unionNameSets` implicit_uses)
352
353         ; let
354             -- The variables "used" in the val binds are:
355             --   (1) the uses of the binds (allUses)
356             --   (2) the FVs of the thing-inside
357             all_uses = allUses dus `plusFV` result_fvs
358                 -- Note [Unused binding hack]
359                 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
360                 -- Note that *in contrast* to the above reporting of
361                 -- unused bindings, (1) above uses duUses to return *all*
362                 -- the uses, even if the binding is unused.  Otherwise consider:
363                 --      x = 3
364                 --      y = let p = x in 'x'    -- NB: p not used
365                 -- If we don't "see" the dependency of 'y' on 'x', we may put the
366                 -- bindings in the wrong order, and the type checker will complain
367                 -- that x isn't in scope
368                 --
369                 -- But note that this means we won't report 'x' as unused,
370                 -- whereas we would if we had { x = 3; p = x; y = 'x' }
371
372         ; return (result, all_uses) }}
373                 -- The bound names are pruned out of all_uses
374                 -- by the bindLocalNamesFV call above
375
376 rnLocalValBindsAndThen bs _ = pprPanic "rnLocalValBindsAndThen" (ppr bs)
377
378
379 -- Process the fixity declarations, making a FastString -> (Located Fixity) map
380 -- (We keep the location around for reporting duplicate fixity declarations.)
381 --
382 -- Checks for duplicates, but not that only locally defined things are fixed.
383 -- Note: for local fixity declarations, duplicates would also be checked in
384 --       check_sigs below.  But we also use this function at the top level.
385
386 makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
387
388 makeMiniFixityEnv decls = foldlM add_one emptyFsEnv decls
389  where
390    add_one env (L loc (FixitySig (L name_loc name) fixity)) = do
391      { -- this fixity decl is a duplicate iff
392        -- the ReaderName's OccName's FastString is already in the env
393        -- (we only need to check the local fix_env because
394        --  definitions of non-local will be caught elsewhere)
395        let { fs = occNameFS (rdrNameOcc name)
396            ; fix_item = L loc fixity };
397
398        case lookupFsEnv env fs of
399          Nothing -> return $ extendFsEnv env fs fix_item
400          Just (L loc' _) -> do
401            { setSrcSpan loc $
402              addErrAt name_loc (dupFixityDecl loc' name)
403            ; return env}
404      }
405
406 dupFixityDecl :: SrcSpan -> RdrName -> SDoc
407 dupFixityDecl loc rdr_name
408   = vcat [ptext (sLit "Multiple fixity declarations for") <+> quotes (ppr rdr_name),
409           ptext (sLit "also at ") <+> ppr loc]
410
411 ---------------------
412
413 -- renaming a single bind
414
415 rnBindLHS :: NameMaker
416           -> SDoc
417           -> HsBind RdrName
418           -- returns the renamed left-hand side,
419           -- and the FreeVars *of the LHS*
420           -- (i.e., any free variables of the pattern)
421           -> RnM (HsBindLR Name RdrName)
422
423 rnBindLHS name_maker _ bind@(PatBind { pat_lhs = pat })
424   = do
425       -- we don't actually use the FV processing of rnPatsAndThen here
426       (pat',pat'_fvs) <- rnBindPat name_maker pat
427       return (bind { pat_lhs = pat', bind_fvs = pat'_fvs })
428                 -- We temporarily store the pat's FVs in bind_fvs;
429                 -- gets updated to the FVs of the whole bind
430                 -- when doing the RHS below
431
432 rnBindLHS name_maker _ bind@(FunBind { fun_id = name@(L nameLoc _) })
433   = do { newname <- applyNameMaker name_maker name
434        ; return (bind { fun_id = L nameLoc newname
435                       , bind_fvs = placeHolderNamesTc }) }
436
437 rnBindLHS name_maker _ (PatSynBind psb@PSB{ psb_id = rdrname@(L nameLoc _) })
438   = do { unless (isTopRecNameMaker name_maker) $
439            addErr localPatternSynonymErr
440        ; addLocM checkConName rdrname
441        ; name <- applyNameMaker name_maker rdrname
442        ; return (PatSynBind psb{ psb_id = L nameLoc name }) }
443   where
444     localPatternSynonymErr :: SDoc
445     localPatternSynonymErr
446       = hang (ptext (sLit "Illegal pattern synonym declaration"))
447            2 (ptext (sLit "Pattern synonym declarations are only valid in the top-level scope"))
448
449 rnBindLHS _ _ b = pprPanic "rnBindHS" (ppr b)
450
451 rnLBind :: (Name -> [Name])             -- Signature tyvar function
452         -> LHsBindLR Name RdrName
453         -> RnM (LHsBind Name, [Name], Uses)
454 rnLBind sig_fn (L loc bind)
455   = setSrcSpan loc $
456     do { (bind', bndrs, dus) <- rnBind sig_fn bind
457        ; return (L loc bind', bndrs, dus) }
458
459 -- assumes the left-hands-side vars are in scope
460 rnBind :: (Name -> [Name])              -- Signature tyvar function
461        -> HsBindLR Name RdrName
462        -> RnM (HsBind Name, [Name], Uses)
463 rnBind _ bind@(PatBind { pat_lhs = pat
464                        , pat_rhs = grhss
465                                    -- pat fvs were stored in bind_fvs
466                                    -- after processing the LHS
467                        , bind_fvs = pat_fvs })
468   = do  { mod <- getModule
469         ; (grhss', rhs_fvs) <- rnGRHSs PatBindRhs rnLExpr grhss
470
471                 -- No scoped type variables for pattern bindings
472         ; let all_fvs = pat_fvs `plusFV` rhs_fvs
473               fvs'    = filterNameSet (nameIsLocalOrFrom mod) all_fvs
474                 -- Keep locally-defined Names
475                 -- As well as dependency analysis, we need these for the
476                 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
477               bndrs = collectPatBinders pat
478               bind' = bind { pat_rhs  = grhss',
479                              pat_rhs_ty = placeHolderType, bind_fvs = fvs' }
480               is_wild_pat = case pat of
481                               L _ (WildPat {})                 -> True
482                               L _ (BangPat (L _ (WildPat {}))) -> True -- #9127
483                               _                                -> False
484
485         -- Warn if the pattern binds no variables, except for the
486         -- entirely-explicit idiom    _ = rhs
487         -- which (a) is not that different from  _v = rhs
488         --       (b) is sometimes used to give a type sig for,
489         --           or an occurrence of, a variable on the RHS
490         ; whenWOptM Opt_WarnUnusedBinds $
491           when (null bndrs && not is_wild_pat) $
492           addWarn $ unusedPatBindWarn bind'
493
494         ; fvs' `seq` -- See Note [Free-variable space leak]
495           return (bind', bndrs, all_fvs) }
496
497 rnBind sig_fn bind@(FunBind { fun_id = name
498                             , fun_infix = is_infix
499                             , fun_matches = matches })
500        -- invariant: no free vars here when it's a FunBind
501   = do  { let plain_name = unLoc name
502
503         ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
504                                 -- bindSigTyVars tests for Opt_ScopedTyVars
505                                  rnMatchGroup (FunRhs plain_name is_infix)
506                                               rnLExpr matches
507         ; when is_infix $ checkPrecMatch plain_name matches'
508
509         ; mod <- getModule
510         ; let fvs' = filterNameSet (nameIsLocalOrFrom mod) rhs_fvs
511                 -- Keep locally-defined Names
512                 -- As well as dependency analysis, we need these for the
513                 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
514
515         ; fvs' `seq` -- See Note [Free-variable space leak]
516           return (bind { fun_matches = matches'
517                        , bind_fvs   = fvs' },
518                   [plain_name], rhs_fvs)
519       }
520
521 rnBind sig_fn (PatSynBind bind)
522   = do  { (bind', name, fvs) <- rnPatSynBind sig_fn bind
523         ; return (PatSynBind bind', name, fvs) }
524
525 rnBind _ b = pprPanic "rnBind" (ppr b)
526
527 {-
528 Note [Free-variable space leak]
529 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
530 We have
531     fvs' = trim fvs
532 and we seq fvs' before turning it as part of a record.
533
534 The reason is that trim is sometimes something like
535     \xs -> intersectNameSet (mkNameSet bound_names) xs
536 and we don't want to retain the list bound_names. This showed up in
537 trac ticket #1136.
538 -}
539
540 rnPatSynBind :: (Name -> [Name])                -- Signature tyvar function
541              -> PatSynBind Name RdrName
542              -> RnM (PatSynBind Name Name, [Name], Uses)
543 rnPatSynBind _sig_fn bind@(PSB { psb_id = L _ name
544                                , psb_args = details
545                                , psb_def = pat
546                                , psb_dir = dir })
547        -- invariant: no free vars here when it's a FunBind
548   = do  { pattern_synonym_ok <- xoptM Opt_PatternSynonyms
549         ; unless pattern_synonym_ok (addErr patternSynonymErr)
550
551         ; ((pat', details'), fvs1) <- rnPat PatSyn pat $ \pat' -> do
552          -- We check the 'RdrName's instead of the 'Name's
553          -- so that the binding locations are reported
554          -- from the left-hand side
555         { (details', fvs) <- case details of
556                PrefixPatSyn vars ->
557                    do { checkDupRdrNames vars
558                       ; names <- mapM lookupVar vars
559                       ; return (PrefixPatSyn names, mkFVs (map unLoc names)) }
560                InfixPatSyn var1 var2 ->
561                    do { checkDupRdrNames [var1, var2]
562                       ; name1 <- lookupVar var1
563                       ; name2 <- lookupVar var2
564                       -- ; checkPrecMatch -- TODO
565                       ; return (InfixPatSyn name1 name2, mkFVs (map unLoc [name1, name2])) }
566         ; return ((pat', details'), fvs) }
567         ; (dir', fvs2) <- case dir of
568             Unidirectional -> return (Unidirectional, emptyFVs)
569             ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
570             ExplicitBidirectional mg ->
571                 do { (mg', fvs) <- rnMatchGroup PatSyn rnLExpr mg
572                    ; return (ExplicitBidirectional mg', fvs) }
573
574         ; mod <- getModule
575         ; let fvs = fvs1 `plusFV` fvs2
576               fvs' = filterNameSet (nameIsLocalOrFrom mod) fvs
577                 -- Keep locally-defined Names
578                 -- As well as dependency analysis, we need these for the
579                 -- MonoLocalBinds test in TcBinds.decideGeneralisationPlan
580
581         ; let bind' = bind{ psb_args = details'
582                           , psb_def = pat'
583                           , psb_dir = dir'
584                           , psb_fvs = fvs' }
585
586         ; fvs' `seq` -- See Note [Free-variable space leak]
587           return (bind', [name], fvs1)
588           -- See Note [Pattern synonym wrappers don't yield dependencies]
589       }
590   where
591     lookupVar = wrapLocM lookupOccRn
592
593     patternSynonymErr :: SDoc
594     patternSynonymErr
595       = hang (ptext (sLit "Illegal pattern synonym declaration"))
596            2 (ptext (sLit "Use -XPatternSynonyms to enable this extension"))
597
598 {-
599 Note [Pattern synonym wrappers don't yield dependencies]
600 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
601
602 When renaming a pattern synonym that has an explicit wrapper,
603 references in the wrapper definition should not be used when
604 calculating dependencies. For example, consider the following pattern
605 synonym definition:
606
607 pattern P x <- C1 x where
608   P x = f (C1 x)
609
610 f (P x) = C2 x
611
612 In this case, 'P' needs to be typechecked in two passes:
613
614 1. Typecheck the pattern definition of 'P', which fully determines the
615 type of 'P'. This step doesn't require knowing anything about 'f',
616 since the wrapper definition is not looked at.
617
618 2. Typecheck the wrapper definition, which needs the typechecked
619 definition of 'f' to be in scope.
620
621 This behaviour is implemented in 'tcValBinds', but it crucially
622 depends on 'P' not being put in a recursive group with 'f' (which
623 would make it look like a recursive pattern synonym a la 'pattern P =
624 P' which is unsound and rejected).
625
626 -}
627
628 ---------------------
629 depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
630              -> ([(RecFlag, LHsBinds Name)], DefUses)
631 -- Dependency analysis; this is important so that
632 -- unused-binding reporting is accurate
633 depAnalBinds binds_w_dus
634   = (map get_binds sccs, map get_du sccs)
635   where
636     sccs = depAnal (\(_, defs, _) -> defs)
637                    (\(_, _, uses) -> nameSetToList uses)
638                    (bagToList binds_w_dus)
639
640     get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
641     get_binds (CyclicSCC  binds_w_dus)  = (Recursive, listToBag [b | (b,_,_) <- binds_w_dus])
642
643     get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
644     get_du (CyclicSCC  binds_w_dus)      = (Just defs, uses)
645         where
646           defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
647           uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]
648
649 ---------------------
650 -- Bind the top-level forall'd type variables in the sigs.
651 -- E.g  f :: a -> a
652 --      f = rhs
653 --      The 'a' scopes over the rhs
654 --
655 -- NB: there'll usually be just one (for a function binding)
656 --     but if there are many, one may shadow the rest; too bad!
657 --      e.g  x :: [a] -> [a]
658 --           y :: [(a,a)] -> a
659 --           (x,y) = e
660 --      In e, 'a' will be in scope, and it'll be the one from 'y'!
661
662 mkSigTvFn :: [LSig Name] -> (Name -> [Name])
663 -- Return a lookup function that maps an Id Name to the names
664 -- of the type variables that should scope over its body..
665 mkSigTvFn sigs
666   = \n -> lookupNameEnv env n `orElse` []
667   where
668     env :: NameEnv [Name]
669     env = mkNameEnv [ (name, hsLKiTyVarNames ltvs)  -- Kind variables and type variables
670                     | L _ (TypeSig names
671                                    (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs
672                     , (L _ name) <- names]
673         -- Note the pattern-match on "Explicit"; we only bind
674         -- type variables from signatures with an explicit top-level for-all
675 \end{code}
676
677
678 @rnMethodBinds@ is used for the method bindings of a class and an instance
679 declaration.   Like @rnBinds@ but without dependency analysis.
680
681 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
682 That's crucial when dealing with an instance decl:
683 \begin{verbatim}
684         instance Foo (T a) where
685            op x = ...
686 \end{verbatim}
687 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
688 and unless @op@ occurs we won't treat the type signature of @op@ in the class
689 decl for @Foo@ as a source of instance-decl gates.  But we should!  Indeed,
690 in many ways the @op@ in an instance decl is just like an occurrence, not
691 a binder.
692
693 \begin{code}
694 rnMethodBinds :: Name                   -- Class name
695               -> (Name -> [Name])       -- Signature tyvar function
696               -> LHsBinds RdrName
697               -> RnM (LHsBinds Name, FreeVars)
698
699 rnMethodBinds cls sig_fn binds
700   = do { checkDupRdrNames meth_names
701              -- Check that the same method is not given twice in the
702              -- same instance decl      instance C T where
703              --                       f x = ...
704              --                       g y = ...
705              --                       f x = ...
706              -- We must use checkDupRdrNames because the Name of the
707              -- method is the Name of the class selector, whose SrcSpan
708              -- points to the class declaration; and we use rnMethodBinds
709              -- for instance decls too
710
711        ; foldlM do_one (emptyBag, emptyFVs) (bagToList binds) }
712   where
713     meth_names  = collectMethodBinders binds
714     do_one (binds,fvs) bind
715        = do { (bind', fvs_bind) <- rnMethodBind cls sig_fn bind
716             ; return (binds `unionBags` bind', fvs_bind `plusFV` fvs) }
717
718 rnMethodBind :: Name
719               -> (Name -> [Name])
720               -> LHsBindLR RdrName RdrName
721               -> RnM (Bag (LHsBindLR Name Name), FreeVars)
722 rnMethodBind cls sig_fn
723              (L loc bind@(FunBind { fun_id = name, fun_infix = is_infix
724                                   , fun_matches = MG { mg_alts = matches
725                                                      , mg_origin = origin } }))
726   = setSrcSpan loc $ do
727     sel_name <- wrapLocM (lookupInstDeclBndr cls (ptext (sLit "method"))) name
728     let plain_name = unLoc sel_name
729         -- We use the selector name as the binder
730
731     (new_matches, fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
732                           mapFvRn (rnMatch (FunRhs plain_name is_infix) rnLExpr)
733                                            matches
734     let new_group = mkMatchGroupName origin new_matches
735
736     when is_infix $ checkPrecMatch plain_name new_group
737     return (unitBag (L loc (bind { fun_id      = sel_name
738                                  , fun_matches = new_group
739                                  , bind_fvs    = fvs })),
740              fvs `addOneFV` plain_name)
741         -- The 'fvs' field isn't used for method binds
742
743 -- Can't handle method pattern-bindings which bind multiple methods.
744 rnMethodBind _ _ (L loc bind@(PatBind {})) = do
745     addErrAt loc (methodBindErr bind)
746     return (emptyBag, emptyFVs)
747
748 rnMethodBind _ _ b = pprPanic "rnMethodBind" (ppr b)
749 \end{code}
750
751
752
753 %************************************************************************
754 %*                                                                      *
755 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
756 %*                                                                      *
757 %************************************************************************
758
759 @renameSigs@ checks for:
760 \begin{enumerate}
761 \item more than one sig for one thing;
762 \item signatures given for things not bound here;
763 \end{enumerate}
764 %
765 At the moment we don't gather free-var info from the types in
766 signatures.  We'd only need this if we wanted to report unused tyvars.
767
768 \begin{code}
769 renameSigs :: HsSigCtxt
770            -> [LSig RdrName]
771            -> RnM ([LSig Name], FreeVars)
772 -- Renames the signatures and performs error checks
773 renameSigs ctxt sigs
774   = do  { mapM_ dupSigDeclErr (findDupSigs sigs)
775
776         ; checkDupMinimalSigs sigs
777
778         ; (sigs', sig_fvs) <- mapFvRn (wrapLocFstM (renameSig ctxt)) sigs
779
780         ; let (good_sigs, bad_sigs) = partition (okHsSig ctxt) sigs'
781         ; mapM_ misplacedSigErr bad_sigs                 -- Misplaced
782
783         ; return (good_sigs, sig_fvs) }
784
785 ----------------------
786 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
787 -- because this won't work for:
788 --      instance Foo T where
789 --        {-# INLINE op #-}
790 --        Baz.op = ...
791 -- We'll just rename the INLINE prag to refer to whatever other 'op'
792 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
793 -- Doesn't seem worth much trouble to sort this.
794
795 renameSig :: HsSigCtxt -> Sig RdrName -> RnM (Sig Name, FreeVars)
796 -- FixitySig is renamed elsewhere.
797 renameSig _ (IdSig x)
798   = return (IdSig x, emptyFVs)    -- Actually this never occurs
799
800 renameSig ctxt sig@(TypeSig vs ty)
801   = do  { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
802         ; (new_ty, fvs) <- rnHsSigType (ppr_sig_bndrs vs) ty
803         ; return (TypeSig new_vs new_ty, fvs) }
804
805 renameSig ctxt sig@(GenericSig vs ty)
806   = do  { defaultSigs_on <- xoptM Opt_DefaultSignatures
807         ; unless defaultSigs_on (addErr (defaultSigErr sig))
808         ; new_v <- mapM (lookupSigOccRn ctxt sig) vs
809         ; (new_ty, fvs) <- rnHsSigType (ppr_sig_bndrs vs) ty
810         ; return (GenericSig new_v new_ty, fvs) }
811
812 renameSig _ (SpecInstSig ty)
813   = do  { (new_ty, fvs) <- rnLHsType SpecInstSigCtx ty
814         ; return (SpecInstSig new_ty,fvs) }
815
816 -- {-# SPECIALISE #-} pragmas can refer to imported Ids
817 -- so, in the top-level case (when mb_names is Nothing)
818 -- we use lookupOccRn.  If there's both an imported and a local 'f'
819 -- then the SPECIALISE pragma is ambiguous, unlike all other signatures
820 renameSig ctxt sig@(SpecSig v ty inl)
821   = do  { new_v <- case ctxt of
822                      TopSigCtxt {} -> lookupLocatedOccRn v
823                      _             -> lookupSigOccRn ctxt sig v
824         ; (new_ty, fvs) <- rnHsSigType (quotes (ppr v)) ty
825         ; return (SpecSig new_v new_ty inl, fvs) }
826
827 renameSig ctxt sig@(InlineSig v s)
828   = do  { new_v <- lookupSigOccRn ctxt sig v
829         ; return (InlineSig new_v s, emptyFVs) }
830
831 renameSig ctxt sig@(FixSig (FixitySig v f))
832   = do  { new_v <- lookupSigOccRn ctxt sig v
833         ; return (FixSig (FixitySig new_v f), emptyFVs) }
834
835 renameSig ctxt sig@(MinimalSig bf)
836   = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf
837        return (MinimalSig new_bf, emptyFVs)
838
839 renameSig ctxt sig@(PatSynSig v args ty prov req)
840   = do  v' <- lookupSigOccRn ctxt sig v
841         let doc = quotes (ppr v)
842             rn_type = rnHsSigType doc
843         (ty', fvs1) <- rn_type ty
844         (args', fvs2) <- case args of
845             PrefixPatSyn tys ->
846                 do (tys, fvs) <- unzip <$> mapM rn_type tys
847                    return (PrefixPatSyn tys, plusFVs fvs)
848             InfixPatSyn left right ->
849                 do (left', fvs1) <- rn_type left
850                    (right', fvs2) <- rn_type right
851                    return (InfixPatSyn left' right', fvs1 `plusFV` fvs2)
852         (prov', fvs3) <- rnContext (TypeSigCtx doc) prov
853         (req', fvs4) <- rnContext (TypeSigCtx doc) req
854         let fvs = plusFVs [fvs1, fvs2, fvs3, fvs4]
855         return (PatSynSig v' args' ty' prov' req', fvs)
856
857 ppr_sig_bndrs :: [Located RdrName] -> SDoc
858 ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
859
860 okHsSig :: HsSigCtxt -> LSig a -> Bool
861 okHsSig ctxt (L _ sig)
862   = case (sig, ctxt) of
863      (GenericSig {}, ClsDeclCtxt {}) -> True
864      (GenericSig {}, _)              -> False
865
866      (TypeSig {}, _)              -> True
867
868      (PatSynSig {}, TopSigCtxt{}) -> True
869      (PatSynSig {}, _)            -> False
870
871      (FixSig {}, InstDeclCtxt {}) -> False
872      (FixSig {}, _)               -> True
873
874      (IdSig {}, TopSigCtxt {})   -> True
875      (IdSig {}, InstDeclCtxt {}) -> True
876      (IdSig {}, _)               -> False
877
878      (InlineSig {}, HsBootCtxt) -> False
879      (InlineSig {}, _)          -> True
880
881      (SpecSig {}, TopSigCtxt {})    -> True
882      (SpecSig {}, LocalBindCtxt {}) -> True
883      (SpecSig {}, InstDeclCtxt {})  -> True
884      (SpecSig {}, _)                -> False
885
886      (SpecInstSig {}, InstDeclCtxt {}) -> True
887      (SpecInstSig {}, _)               -> False
888
889      (MinimalSig {}, ClsDeclCtxt {}) -> True
890      (MinimalSig {}, _)              -> False
891
892 -------------------
893 findDupSigs :: [LSig RdrName] -> [[(Located RdrName, Sig RdrName)]]
894 -- Check for duplicates on RdrName version,
895 -- because renamed version has unboundName for
896 -- not-in-scope binders, which gives bogus dup-sig errors
897 -- NB: in a class decl, a 'generic' sig is not considered
898 --     equal to an ordinary sig, so we allow, say
899 --           class C a where
900 --             op :: a -> a
901 --             default op :: Eq a => a -> a
902 findDupSigs sigs
903   = findDupsEq matching_sig (concatMap (expand_sig . unLoc) sigs)
904   where
905     expand_sig sig@(FixSig (FixitySig n _)) = [(n,sig)]
906     expand_sig sig@(InlineSig n _)          = [(n,sig)]
907     expand_sig sig@(TypeSig  ns _)   = [(n,sig) | n <- ns]
908     expand_sig sig@(GenericSig ns _) = [(n,sig) | n <- ns]
909     expand_sig _ = []
910
911     matching_sig (L _ n1,sig1) (L _ n2,sig2) = n1 == n2 && mtch sig1 sig2
912     mtch (FixSig {})     (FixSig {})     = True
913     mtch (InlineSig {})  (InlineSig {})  = True
914     mtch (TypeSig {})    (TypeSig {})    = True
915     mtch (GenericSig {}) (GenericSig {}) = True
916     mtch _ _ = False
917
918 -- Warn about multiple MINIMAL signatures
919 checkDupMinimalSigs :: [LSig RdrName] -> RnM ()
920 checkDupMinimalSigs sigs
921   = case filter isMinimalLSig sigs of
922       minSigs@(_:_:_) -> dupMinimalSigErr minSigs
923       _ -> return ()
924 \end{code}
925
926
927 %************************************************************************
928 %*                                                                      *
929 \subsection{Match}
930 %*                                                                      *
931 %************************************************************************
932
933 \begin{code}
934 rnMatchGroup :: Outputable (body RdrName) => HsMatchContext Name
935              -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
936              -> MatchGroup RdrName (Located (body RdrName))
937              -> RnM (MatchGroup Name (Located (body Name)), FreeVars)
938 rnMatchGroup ctxt rnBody (MG { mg_alts = ms, mg_origin = origin })
939   = do { empty_case_ok <- xoptM Opt_EmptyCase
940        ; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt))
941        ; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms
942        ; return (mkMatchGroupName origin new_ms, ms_fvs) }
943
944 rnMatch :: Outputable (body RdrName) => HsMatchContext Name
945         -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
946         -> LMatch RdrName (Located (body RdrName))
947         -> RnM (LMatch Name (Located (body Name)), FreeVars)
948 rnMatch ctxt rnBody = wrapLocFstM (rnMatch' ctxt rnBody)
949
950 rnMatch' :: Outputable (body RdrName) => HsMatchContext Name
951          -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
952          -> Match RdrName (Located (body RdrName))
953          -> RnM (Match Name (Located (body Name)), FreeVars)
954 rnMatch' ctxt rnBody match@(Match pats maybe_rhs_sig grhss)
955   = do  {       -- Result type signatures are no longer supported
956           case maybe_rhs_sig of
957                 Nothing -> return ()
958                 Just (L loc ty) -> addErrAt loc (resSigErr ctxt match ty)
959
960                -- Now the main event
961                -- note that there are no local ficity decls for matches
962         ; rnPats ctxt pats      $ \ pats' -> do
963         { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss
964
965         ; return (Match pats' Nothing grhss', grhss_fvs) }}
966
967 emptyCaseErr :: HsMatchContext Name -> SDoc
968 emptyCaseErr ctxt = hang (ptext (sLit "Empty list of alternatives in") <+> pp_ctxt)
969                        2 (ptext (sLit "Use EmptyCase to allow this"))
970   where
971     pp_ctxt = case ctxt of
972                 CaseAlt    -> ptext (sLit "case expression")
973                 LambdaExpr -> ptext (sLit "\\case expression")
974                 _ -> ptext (sLit "(unexpected)") <+> pprMatchContextNoun ctxt
975
976
977 resSigErr :: Outputable body
978           => HsMatchContext Name -> Match RdrName body -> HsType RdrName -> SDoc
979 resSigErr ctxt match ty
980    = vcat [ ptext (sLit "Illegal result type signature") <+> quotes (ppr ty)
981           , nest 2 $ ptext (sLit
982                  "Result signatures are no longer supported in pattern matches")
983           , pprMatchInCtxt ctxt match ]
984 \end{code}
985
986
987 %************************************************************************
988 %*                                                                      *
989 \subsubsection{Guarded right-hand sides (GRHSs)}
990 %*                                                                      *
991 %************************************************************************
992
993 \begin{code}
994 rnGRHSs :: HsMatchContext Name
995         -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
996         -> GRHSs RdrName (Located (body RdrName))
997         -> RnM (GRHSs Name (Located (body Name)), FreeVars)
998 rnGRHSs ctxt rnBody (GRHSs grhss binds)
999   = rnLocalBindsAndThen binds   $ \ binds' -> do
1000     (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss
1001     return (GRHSs grhss' binds', fvGRHSs)
1002
1003 rnGRHS :: HsMatchContext Name
1004        -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
1005        -> LGRHS RdrName (Located (body RdrName))
1006        -> RnM (LGRHS Name (Located (body Name)), FreeVars)
1007 rnGRHS ctxt rnBody = wrapLocFstM (rnGRHS' ctxt rnBody)
1008
1009 rnGRHS' :: HsMatchContext Name
1010         -> (Located (body RdrName) -> RnM (Located (body Name), FreeVars))
1011         -> GRHS RdrName (Located (body RdrName))
1012         -> RnM (GRHS Name (Located (body Name)), FreeVars)
1013 rnGRHS' ctxt rnBody (GRHS guards rhs)
1014   = do  { pattern_guards_allowed <- xoptM Opt_PatternGuards
1015         ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) rnLExpr guards $ \ _ ->
1016                                     rnBody rhs
1017
1018         ; unless (pattern_guards_allowed || is_standard_guard guards')
1019                  (addWarn (nonStdGuardErr guards'))
1020
1021         ; return (GRHS guards' rhs', fvs) }
1022   where
1023         -- Standard Haskell 1.4 guards are just a single boolean
1024         -- expression, rather than a list of qualifiers as in the
1025         -- Glasgow extension
1026     is_standard_guard []                       = True
1027     is_standard_guard [L _ (BodyStmt _ _ _ _)] = True
1028     is_standard_guard _                        = False
1029 \end{code}
1030
1031 %************************************************************************
1032 %*                                                                      *
1033 \subsection{Error messages}
1034 %*                                                                      *
1035 %************************************************************************
1036
1037 \begin{code}
1038 dupSigDeclErr :: [(Located RdrName, Sig RdrName)] -> RnM ()
1039 dupSigDeclErr pairs@((L loc name, sig) : _)
1040   = addErrAt loc $
1041     vcat [ ptext (sLit "Duplicate") <+> what_it_is
1042            <> ptext (sLit "s for") <+> quotes (ppr name)
1043          , ptext (sLit "at") <+> vcat (map ppr $ sort $ map (getLoc . fst) pairs) ]
1044   where
1045     what_it_is = hsSigDoc sig
1046
1047 dupSigDeclErr [] = panic "dupSigDeclErr"
1048
1049 misplacedSigErr :: LSig Name -> RnM ()
1050 misplacedSigErr (L loc sig)
1051   = addErrAt loc $
1052     sep [ptext (sLit "Misplaced") <+> hsSigDoc sig <> colon, ppr sig]
1053
1054 defaultSigErr :: Sig RdrName -> SDoc
1055 defaultSigErr sig = vcat [ hang (ptext (sLit "Unexpected default signature:"))
1056                               2 (ppr sig)
1057                          , ptext (sLit "Use DefaultSignatures to enable default signatures") ]
1058
1059 methodBindErr :: HsBindLR RdrName RdrName -> SDoc
1060 methodBindErr mbind
1061  =  hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))
1062        2 (ppr mbind)
1063
1064 bindsInHsBootFile :: LHsBindsLR Name RdrName -> SDoc
1065 bindsInHsBootFile mbinds
1066   = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))
1067        2 (ppr mbinds)
1068
1069 nonStdGuardErr :: Outputable body => [LStmtLR Name Name body] -> SDoc
1070 nonStdGuardErr guards
1071   = hang (ptext (sLit "accepting non-standard pattern guards (use PatternGuards to suppress this message)"))
1072        4 (interpp'SP guards)
1073
1074 unusedPatBindWarn :: HsBind Name -> SDoc
1075 unusedPatBindWarn bind
1076   = hang (ptext (sLit "This pattern-binding binds no variables:"))
1077        2 (ppr bind)
1078
1079 dupMinimalSigErr :: [LSig RdrName] -> RnM ()
1080 dupMinimalSigErr sigs@(L loc _ : _)
1081   = addErrAt loc $
1082     vcat [ ptext (sLit "Multiple minimal complete definitions")
1083          , ptext (sLit "at") <+> vcat (map ppr $ sort $ map getLoc sigs)
1084          , ptext (sLit "Combine alternative minimal complete definitions with `|'") ]
1085 dupMinimalSigErr [] = panic "dupMinimalSigErr"
1086 \end{code}