RnBinds.lhs 31.6 KB
 simonmar committed Jun 17, 1999 1 2 3 4 5 6 7 8 9 10 11 % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[RnBinds]{Renaming and dependency analysis of bindings} This module does renaming and dependency analysis on value bindings in the abstract syntax. It does {\em not} do cycle-checks on class or type-synonym declarations; those cannot be done at this stage because they may be affected by renaming (which isn't fully worked out yet). \begin{code}  Dan Licata committed Oct 10, 2007 12 13 14 15 module RnBinds (rnTopBinds, rnTopBindsLHS, rnTopBindsRHS, -- use these for top-level bindings rnLocalBindsAndThen, rnValBindsLHS, rnValBindsRHS, -- or these for local bindings rnMethodBinds, renameSigs, mkSigTvFn, rnMatchGroup, rnGRHSs,  simonpj@microsoft.com committed Apr 04, 2008 16  makeMiniFixityEnv, MiniFixityEnv  simonmar committed Jun 17, 1999 17 18  ) where  simonpj committed Jul 19, 2005 19 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )  simonmar committed Jun 17, 1999 20 21 22 23  import HsSyn import RdrHsSyn import RnHsSyn  simonpj committed Sep 13, 2002 24 import TcRnMonad  simonpj@microsoft.com committed Jun 04, 2008 25 import RnTypes ( rnHsSigType, rnLHsType, checkPrecMatch)  simonpj@microsoft.com committed Aug 20, 2009 26 import RnPat (rnPats, rnBindPat,  simonpj@microsoft.com committed Jun 04, 2008 27 28  NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker )  Dan Licata committed Oct 10, 2007 29   simonpj@microsoft.com committed Apr 04, 2008 30 import RnEnv  simonmar committed Mar 18, 2005 31 import DynFlags ( DynFlag(..) )  simonpj@microsoft.com committed May 02, 2007 32 import Name  simonpj committed Jul 19, 2005 33 import NameEnv  simonmar committed Jun 17, 1999 34 import NameSet  simonpj committed Oct 03, 2000 35 import RdrName ( RdrName, rdrNameOcc )  Ian Lynagh committed May 03, 2008 36 import SrcLoc  simonpj committed Jul 19, 2005 37 import ListSetOps ( findDupsEq )  simonpj committed Aug 10, 2005 38 import BasicTypes ( RecFlag(..) )  batterseapower committed Jul 31, 2008 39 import Digraph ( SCC(..), stronglyConnCompFromEdgedVertices )  simonmar committed Dec 10, 2003 40 import Bag  simonmar committed Jun 17, 1999 41 import Outputable  Ian Lynagh committed Mar 29, 2008 42 import FastString  simonpj@microsoft.com committed May 20, 2008 43 import Data.List ( partition )  simonpj@microsoft.com committed May 08, 2006 44 import Maybes ( orElse )  Ian Lynagh committed Jul 24, 2009 45 import Control.Monad  simonmar committed Jun 17, 1999 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 \end{code} -- ToDo: Put the annotations into the monad, so that they arrive in the proper -- place and can be used when complaining. The code tree received by the function @rnBinds@ contains definitions in where-clauses which are all apparently mutually recursive, but which may not really depend upon each other. For example, in the top level program \begin{verbatim} f x = y where a = x y = x \end{verbatim} the definitions of @a@ and @y@ do not depend on each other at all. Unfortunately, the typechecker cannot always check such definitions. \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive definitions. In Proceedings of the International Symposium on Programming, Toulouse, pp. 217-39. LNCS 167. Springer Verlag.} However, the typechecker usually can check definitions in which only the strongly connected components have been collected into recursive bindings. This is precisely what the function @rnBinds@ does. ToDo: deal with case where a single monobinds binds the same variable twice. The vertag tag is a unique @Int@; the tags only need to be unique within one @MonoBinds@, so that unique-Int plumbing is done explicitly (heavy monad machinery not needed). %************************************************************************ %* * %* naming conventions * %* * %************************************************************************ \subsection[name-conventions]{Name conventions} The basic algorithm involves walking over the tree and returning a tuple containing the new tree plus its free variables. Some functions, such as those walking polymorphic bindings (HsBinds) and qualifier lists in list comprehensions (@Quals@), return the variables bound in local environments. These are then used to calculate the free variables of the expression evaluated in these environments. Conventions for variable names are as follows: \begin{itemize} \item new code is given a prime to distinguish it from the old. \item a set of variables defined in @Exp@ is written @dvExp@ \item a set of variables free in @Exp@ is written @fvExp@ \end{itemize} %************************************************************************ %* *  simonmar committed Dec 10, 2003 104 %* analysing polymorphic bindings (HsBindGroup, HsBind)  simonmar committed Jun 17, 1999 105 106 107 108 109 110 111 112 113 114 115 %* * %************************************************************************ \subsubsection[dep-HsBinds]{Polymorphic bindings} Non-recursive expressions are reconstructed without any changes at top level, although their component expressions may have to be altered. However, non-recursive expressions are currently not expected as \Haskell{} programs, and this code should not be executed. Monomorphic bindings contain information that is returned in a tuple  simonpj committed Sep 27, 2002 116 (a @FlatMonoBinds@) containing:  simonmar committed Jun 17, 1999 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154  \begin{enumerate} \item a unique @Int@ that serves as the vertex tag'' for this binding. \item the name of a function or the names in a pattern. These are a set referred to as @dvLhs@, the defined variables of the left hand side. \item the free variables of the body. These are referred to as @fvBody@. \item the definition's actual code. This is referred to as just @code@. \end{enumerate} The function @nonRecDvFv@ returns two sets of variables. The first is the set of variables defined in the set of monomorphic bindings, while the second is the set of free variables in those bindings. The set of variables defined in a non-recursive binding is just the union of all of them, as @union@ removes duplicates. However, the free variables in each successive set of cumulative bindings is the union of those in the previous set plus those of the newest binding after the defined variables of the previous set have been removed. @rnMethodBinds@ deals only with the declarations in class and instance declarations. It expects only to see @FunMonoBind@s, and it expects the global environment to contain bindings for the binders (which are all class operations). %************************************************************************ %* * \subsubsection{ Top-level bindings} %* * %************************************************************************ \begin{code}  Dan Licata committed Oct 10, 2007 155 156 -- for top-level bindings, we need to make top-level names, -- so we have a different entry point than for local bindings  simonpj@microsoft.com committed Apr 04, 2008 157 rnTopBindsLHS :: MiniFixityEnv  Dan Licata committed Oct 10, 2007 158 159  -> HsValBinds RdrName -> RnM (HsValBindsLR Name RdrName)  simonpj@microsoft.com committed Aug 20, 2009 160 rnTopBindsLHS fix_env binds  simonpj@microsoft.com committed May 25, 2010 161  = rnValBindsLHSFromDoc (topRecNameMaker fix_env) binds  Dan Licata committed Oct 10, 2007 162   simonpj@microsoft.com committed Oct 27, 2008 163 rnTopBindsRHS :: NameSet -- Names bound by these binds  Dan Licata committed Oct 10, 2007 164 165 166 167 168 169 170 171 172  -> HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses) rnTopBindsRHS bound_names binds = do { is_boot <- tcIsHsBoot ; if is_boot then rnTopBindsBoot binds else rnValBindsRHSGen (\x -> x) -- don't trim free vars bound_names binds }  simonpj@microsoft.com committed Oct 27, 2008 173 -- Wrapper if we don't need to do anything in between the left and right,  Dan Licata committed Oct 10, 2007 174 175 -- or anything else in the scope of the left --  simonpj@microsoft.com committed Oct 27, 2008 176 -- Never used when there are fixity declarations  Dan Licata committed Oct 10, 2007 177 178 179 rnTopBinds :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses) rnTopBinds b =  simonpj@microsoft.com committed Apr 10, 2008 180  do nl <- rnTopBindsLHS emptyFsEnv b  simonpj@microsoft.com committed Mar 04, 2010 181  let bound_names = collectHsValBinders nl  simonpj@microsoft.com committed Oct 27, 2008 182  bindLocalNames bound_names $rnTopBindsRHS (mkNameSet bound_names) nl  Dan Licata committed Oct 10, 2007 183 184 185  rnTopBindsBoot :: HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)  simonpj committed Jan 27, 2005 186 187 -- A hs-boot file has no bindings. -- Return a single HsBindGroup with empty binds and renamed signatures  simonpj committed Jul 19, 2005 188 rnTopBindsBoot (ValBindsIn mbinds sigs)  simonpj committed Jan 27, 2005 189  = do { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)  simonpj@microsoft.com committed May 20, 2008 190  ; sigs' <- renameSigs Nothing okHsBootSig sigs  simonpj committed Aug 11, 2005 191  ; return (ValBindsOut [] sigs', usesOnly (hsSigsFVs sigs')) }  Ian Lynagh committed May 03, 2008 192 rnTopBindsBoot b = pprPanic "rnTopBindsBoot" (ppr b)  simonpj committed Jul 19, 2005 193 194 195 196 197 198 199 200 201 202 203 \end{code} %********************************************************* %* * HsLocalBinds %* * %********************************************************* \begin{code}  Dan Licata committed Oct 10, 2007 204 205 206 207 208 rnLocalBindsAndThen :: HsLocalBinds RdrName -> (HsLocalBinds Name -> RnM (result, FreeVars)) -> RnM (result, FreeVars) -- This version (a) assumes that the binding vars are *not* already in scope -- (b) removes the binders from the free vars of the thing inside  simonpj committed Jul 19, 2005 209 210 211 212 213 214 -- The parser doesn't produce ThenBinds rnLocalBindsAndThen EmptyLocalBinds thing_inside = thing_inside EmptyLocalBinds rnLocalBindsAndThen (HsValBinds val_binds) thing_inside = rnValBindsAndThen val_binds$ \ val_binds' ->  Dan Licata committed Oct 10, 2007 215  thing_inside (HsValBinds val_binds')  simonpj committed Jul 19, 2005 216   twanvl committed Jan 17, 2008 217 218 219 220 rnLocalBindsAndThen (HsIPBinds binds) thing_inside = do (binds',fv_binds) <- rnIPBinds binds (thing, fvs_thing) <- thing_inside (HsIPBinds binds') return (thing, fvs_thing plusFV fv_binds)  simonpj committed Jul 19, 2005 221   Ian Lynagh committed May 03, 2008 222 rnIPBinds :: HsIPBinds RdrName -> RnM (HsIPBinds Name, FreeVars)  twanvl committed Jan 17, 2008 223 224 225 rnIPBinds (IPBinds ip_binds _no_dict_binds) = do (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds return (IPBinds ip_binds' emptyLHsBinds, plusFVs fvs_s)  simonpj committed Jul 19, 2005 226   Ian Lynagh committed May 03, 2008 227 rnIPBind :: IPBind RdrName -> RnM (IPBind Name, FreeVars)  twanvl committed Jan 17, 2008 228 229 230 rnIPBind (IPBind n expr) = do name <- newIPNameRn n (expr',fvExpr) <- rnLExpr expr  simonpj committed Jul 19, 2005 231  return (IPBind name expr', fvExpr)  simonmar committed Jun 17, 1999 232 233 \end{code}  simonpj committed Sep 27, 2002 234   simonmar committed Jun 17, 1999 235 236 %************************************************************************ %* *  simonpj committed Jul 19, 2005 237  ValBinds  simonmar committed Jun 17, 1999 238 239 240 241 %* * %************************************************************************ \begin{code}  simonpj@microsoft.com committed Nov 05, 2009 242 243 -- Renaming local binding gropus -- Does duplicate/shadow check  simonpj@microsoft.com committed Apr 04, 2008 244 rnValBindsLHS :: MiniFixityEnv  Dan Licata committed Oct 10, 2007 245  -> HsValBinds RdrName  simonpj@microsoft.com committed Nov 05, 2009 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262  -> RnM ([Name], HsValBindsLR Name RdrName) rnValBindsLHS fix_env binds = do { -- Do error checking: we need to check for dups here because we -- don't don't bind all of the variables from the ValBinds at once -- with bindLocatedLocals any more. -- -- Note that we don't want to do this at the top level, since -- sorting out duplicates and shadowing there happens elsewhere. -- The behavior is even different. For example, -- import A(f) -- f = ... -- should not produce a shadowing warning (but it will produce -- an ambiguity warning if you use f), but -- import A(f) -- g = let f = ... in f -- should. ; binds' <- rnValBindsLHSFromDoc (localRecNameMaker fix_env) binds  simonpj@microsoft.com committed Mar 04, 2010 263  ; let bound_names = collectHsValBinders binds'  simonpj@microsoft.com committed Nov 05, 2009 264 265 266  ; envs <- getRdrEnvs ; checkDupAndShadowedNames envs bound_names ; return (bound_names, binds') }  Dan Licata committed Oct 10, 2007 267 268 269 270  -- renames the left-hand sides -- generic version used both at the top level and for local binds -- does some error checking, but not what gets done elsewhere at the top level  simonpj@microsoft.com committed Dec 13, 2007 271 rnValBindsLHSFromDoc :: NameMaker  Dan Licata committed Oct 10, 2007 272 273  -> HsValBinds RdrName -> RnM (HsValBindsLR Name RdrName)  simonpj@microsoft.com committed Nov 05, 2009 274 275 276 277 rnValBindsLHSFromDoc topP (ValBindsIn mbinds sigs) = do { mbinds' <- mapBagM (rnBindLHS topP doc) mbinds ; return $ValBindsIn mbinds' sigs } where  simonpj@microsoft.com committed Mar 04, 2010 278  bndrs = collectHsBindsBinders mbinds  simonpj@microsoft.com committed Nov 05, 2009 279 280 281  doc = text "In the binding group for:" <+> pprWithCommas ppr bndrs rnValBindsLHSFromDoc _ b = pprPanic "rnValBindsLHSFromDoc" (ppr b)  Dan Licata committed Oct 10, 2007 282   simonpj@microsoft.com committed May 20, 2008 283 284 -- General version used both from the top-level and for local things -- Assumes the LHS vars are in scope  Dan Licata committed Oct 10, 2007 285 --  simonpj@microsoft.com committed May 20, 2008 286 -- Does not bind the local fixity declarations  Dan Licata committed Oct 10, 2007 287 288 289 rnValBindsRHSGen :: (FreeVars -> FreeVars) -- for trimming free var sets -- The trimming function trims the free vars we attach to a -- binding so that it stays reasonably small  simonpj@microsoft.com committed Oct 27, 2008 290  -> NameSet -- Names bound by the LHSes  Dan Licata committed Oct 10, 2007 291 292 293  -> HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)  simonpj@microsoft.com committed Nov 05, 2009 294 295 296 297 298 299 300 301 302 303 rnValBindsRHSGen trim bound_names (ValBindsIn mbinds sigs) = do { -- rename the sigs sigs' <- renameSigs (Just bound_names) okBindSig sigs -- rename the RHSes ; binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds ; case depAnalBinds binds_w_dus of (anal_binds, anal_dus) -> do { let valbind' = ValBindsOut anal_binds sigs' valbind'_dus = usesOnly (hsSigsFVs sigs') plusDU anal_dus ; return (valbind', valbind'_dus) }}  Dan Licata committed Oct 10, 2007 304   Ian Lynagh committed May 03, 2008 305 306 rnValBindsRHSGen _ _ b = pprPanic "rnValBindsRHSGen" (ppr b)  simonpj@microsoft.com committed Apr 03, 2008 307 -- Wrapper for local binds  Dan Licata committed Oct 10, 2007 308 --  simonpj@microsoft.com committed Apr 03, 2008 309 -- The *client* of this function is responsible for checking for unused binders;  Dan Licata committed Oct 10, 2007 310 311 -- it doesn't (and can't: we don't have the thing inside the binds) happen here --  simonpj@microsoft.com committed Apr 03, 2008 312 -- The client is also responsible for bringing the fixities into scope  simonpj@microsoft.com committed Oct 27, 2008 313 rnValBindsRHS :: NameSet -- names bound by the LHSes  Dan Licata committed Oct 10, 2007 314 315  -> HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)  simonpj@microsoft.com committed Apr 12, 2010 316 317 318 319 320 rnValBindsRHS bound_names binds = rnValBindsRHSGen trim bound_names binds where trim fvs = intersectNameSet bound_names fvs -- Only keep the names the names from this group  Dan Licata committed Oct 10, 2007 321 322 323 324 325 326 327 328 329  -- for local binds -- wrapper that does both the left- and right-hand sides -- -- here there are no local fixity decls passed in; -- the local fixity decls come from the ValBinds sigs rnValBindsAndThen :: HsValBinds RdrName -> (HsValBinds Name -> RnM (result, FreeVars)) -> RnM (result, FreeVars)  simonpj@microsoft.com committed Apr 03, 2008 330 rnValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside  simonpj@microsoft.com committed Nov 05, 2009 331 332  = do { -- (A) Create the local fixity environment new_fixities <- makeMiniFixityEnv [L loc sig | L loc (FixSig sig) <- sigs]  Dan Licata committed Oct 10, 2007 333   simonpj@microsoft.com committed Apr 03, 2008 334  -- (B) Rename the LHSes  simonpj@microsoft.com committed Nov 05, 2009 335  ; (bound_names, new_lhs) <- rnValBindsLHS new_fixities binds  Dan Licata committed Oct 10, 2007 336   simonpj@microsoft.com committed Apr 03, 2008 337  -- ...and bring them (and their fixities) into scope  simonpj@microsoft.com committed Apr 12, 2010 338 339  ; bindLocalNamesFV bound_names$ addLocalFixities new_fixities bound_names $do  Dan Licata committed Oct 10, 2007 340   simonpj@microsoft.com committed Apr 03, 2008 341  { -- (C) Do the RHS and thing inside  simonpj@microsoft.com committed Oct 27, 2008 342  (binds', dus) <- rnValBindsRHS (mkNameSet bound_names) new_lhs  simonpj@microsoft.com committed Apr 03, 2008 343  ; (result, result_fvs) <- thing_inside binds'  Dan Licata committed Oct 10, 2007 344   simonpj@microsoft.com committed Apr 03, 2008 345 346 347 348 349 350  -- Report unused bindings based on the (accurate) -- findUses. E.g. -- let x = x in 3 -- should report 'x' unused ; let real_uses = findUses dus result_fvs ; warnUnusedLocalBinds bound_names real_uses  Dan Licata committed Oct 10, 2007 351   simonpj@microsoft.com committed Apr 03, 2008 352 353  ; let -- The variables "used" in the val binds are:  simonpj@microsoft.com committed May 06, 2010 354  -- (1) the uses of the binds (allUses)  Dan Licata committed Oct 10, 2007 355  -- (2) the FVs of the thing-inside  simonpj@microsoft.com committed May 06, 2010 356  all_uses = allUses dus plusFV result_fvs  simonpj@microsoft.com committed Apr 03, 2008 357 358 359 360 361  -- Note [Unused binding hack] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Note that *in contrast* to the above reporting of -- unused bindings, (1) above uses duUses to return *all* -- the uses, even if the binding is unused. Otherwise consider:  Dan Licata committed Oct 10, 2007 362 363 364 365 366  -- x = 3 -- y = let p = x in 'x' -- NB: p not used -- If we don't "see" the dependency of 'y' on 'x', we may put the -- bindings in the wrong order, and the type checker will complain -- that x isn't in scope  simonpj@microsoft.com committed Apr 03, 2008 367 368 369 370 371 372 373  -- -- But note that this means we won't report 'x' as unused, -- whereas we would if we had { x = 3; p = x; y = 'x' } ; return (result, all_uses) }} -- The bound names are pruned out of all_uses -- by the bindLocalNamesFV call above  Ian Lynagh committed May 03, 2008 374 375  rnValBindsAndThen bs _ = pprPanic "rnValBindsAndThen" (ppr bs)  Dan Licata committed Oct 10, 2007 376 377 378 379 380 381 382 383  -- Process the fixity declarations, making a FastString -> (Located Fixity) map -- (We keep the location around for reporting duplicate fixity declarations.) -- -- Checks for duplicates, but not that only locally defined things are fixed. -- Note: for local fixity declarations, duplicates would also be checked in -- check_sigs below. But we also use this function at the top level.  simonpj@microsoft.com committed Apr 04, 2008 384 385 386  makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv  simonpj@microsoft.com committed Apr 10, 2008 387 makeMiniFixityEnv decls = foldlM add_one emptyFsEnv decls  Dan Licata committed Oct 10, 2007 388 389 390 391 392 393  where add_one env (L loc (FixitySig (L name_loc name) fixity)) = do { -- this fixity decl is a duplicate iff -- the ReaderName's OccName's FastString is already in the env -- (we only need to check the local fix_env because -- definitions of non-local will be caught elsewhere)  simonpj@microsoft.com committed Apr 10, 2008 394 395  let { fs = occNameFS (rdrNameOcc name) ; fix_item = L loc fixity };  Dan Licata committed Oct 10, 2007 396   simonpj@microsoft.com committed Apr 10, 2008 397 398  case lookupFsEnv env fs of Nothing -> return$ extendFsEnv env fs fix_item  Dan Licata committed Oct 10, 2007 399 400  Just (L loc' _) -> do { setSrcSpan loc $ simonpj@microsoft.com committed Nov 05, 2009 401  addErrAt name_loc (dupFixityDecl loc' name)  Dan Licata committed Oct 10, 2007 402 403 404  ; return env} }  Ian Lynagh committed May 03, 2008 405 dupFixityDecl :: SrcSpan -> RdrName -> SDoc  Dan Licata committed Oct 10, 2007 406 dupFixityDecl loc rdr_name  Ian Lynagh committed Apr 12, 2008 407 408  = vcat [ptext (sLit "Multiple fixity declarations for") <+> quotes (ppr rdr_name), ptext (sLit "also at ") <+> ppr loc]  simonpj committed Feb 21, 2003 409   simonpj committed Jul 19, 2005 410 ---------------------  simonpj committed Feb 21, 2003 411   Dan Licata committed Oct 10, 2007 412 413 -- renaming a single bind  simonpj@microsoft.com committed Dec 13, 2007 414 rnBindLHS :: NameMaker  Dan Licata committed Oct 10, 2007 415 416 417 418 419 420 421  -> SDoc -> LHsBind RdrName -- returns the renamed left-hand side, -- and the FreeVars *of the LHS* -- (i.e., any free variables of the pattern) -> RnM (LHsBindLR Name RdrName)  Ian Lynagh committed May 03, 2008 422 423 424 425 rnBindLHS name_maker _ (L loc (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty=pat_rhs_ty }))  Dan Licata committed Oct 10, 2007 426 427  = setSrcSpan loc$ do -- we don't actually use the FV processing of rnPatsAndThen here  simonpj@microsoft.com committed Dec 13, 2007 428  (pat',pat'_fvs) <- rnBindPat name_maker pat  Dan Licata committed Oct 10, 2007 429 430 431 432 433 434 435 436 437 438  return (L loc (PatBind { pat_lhs = pat', pat_rhs = grhss, -- we temporarily store the pat's FVs here; -- gets updated to the FVs of the whole bind -- when doing the RHS below bind_fvs = pat'_fvs, -- these will get ignored in the next pass, -- when we rename the RHS pat_rhs_ty = pat_rhs_ty }))  Ian Lynagh committed May 03, 2008 439 440 441 442 443 444 rnBindLHS name_maker _ (L loc (FunBind { fun_id = name@(L nameLoc _), fun_infix = inf, fun_matches = matches, fun_co_fn = fun_co_fn, fun_tick = fun_tick }))  simonpj@microsoft.com committed Dec 13, 2007 445  = setSrcSpan loc $ simonpj@microsoft.com committed Aug 20, 2009 446  do { newname <- applyNameMaker name_maker name  simonpj@microsoft.com committed Dec 13, 2007 447 448 449 450 451 452 453 454 455 456  ; return (L loc (FunBind { fun_id = L nameLoc newname, fun_infix = inf, fun_matches = matches, -- we temporatily store the LHS's FVs (empty in this case) here -- gets updated when doing the RHS below bind_fvs = emptyFVs, -- everything else will get ignored in the next pass fun_co_fn = fun_co_fn, fun_tick = fun_tick })) }  Dan Licata committed Oct 10, 2007 457   Ian Lynagh committed May 03, 2008 458 459 rnBindLHS _ _ b = pprPanic "rnBindLHS" (ppr b)  Dan Licata committed Oct 10, 2007 460 461 462 463 464 -- assumes the left-hands-side vars are in scope rnBind :: (Name -> [Name]) -- Signature tyvar function -> (FreeVars -> FreeVars) -- Trimming function for rhs free vars -> LHsBindLR Name RdrName -> RnM (LHsBind Name, [Name], Uses)  Ian Lynagh committed May 03, 2008 465 466 467 rnBind _ trim (L loc (PatBind { pat_lhs = pat, pat_rhs = grhss, -- pat fvs were stored here while  simonpj@microsoft.com committed Apr 12, 2010 468 469  -- after processing the LHS bind_fvs = pat_fvs }))  Dan Licata committed Oct 10, 2007 470 471  = setSrcSpan loc$ do {let bndrs = collectPatBinders pat  simonpj committed Jul 19, 2005 472   Dan Licata committed Oct 10, 2007 473 474  ; (grhss', fvs) <- rnGRHSs PatBindRhs grhss -- No scoped type variables for pattern bindings  simonpj@microsoft.com committed Apr 12, 2010 475 476  ; let all_fvs = pat_fvs plusFV fvs fvs' = trim all_fvs  simonpj committed Aug 10, 2005 477   Ian Lynagh committed Sep 04, 2008 478  ; fvs' seq -- See Note [Free-variable space leak]  simonpj@microsoft.com committed Apr 12, 2010 479 480 481 482 483  return (L loc (PatBind { pat_lhs = pat, pat_rhs = grhss', pat_rhs_ty = placeHolderType, bind_fvs = fvs' }), bndrs, all_fvs) }  simonpj committed Aug 10, 2005 484   Dan Licata committed Oct 10, 2007 485 486 487 rnBind sig_fn trim (L loc (FunBind { fun_id = name,  simonpj@microsoft.com committed Jan 07, 2010 488  fun_infix = is_infix,  Dan Licata committed Oct 10, 2007 489 490 491 492 493 494 495  fun_matches = matches, -- no pattern FVs bind_fvs = _ })) -- invariant: no free vars here when it's a FunBind = setSrcSpan loc $do { let plain_name = unLoc name  simonpj committed Aug 10, 2005 496   Dan Licata committed Oct 10, 2007 497 498  ; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name)$ -- bindSigTyVars tests for Opt_ScopedTyVars  simonpj@microsoft.com committed Jan 07, 2010 499  rnMatchGroup (FunRhs plain_name is_infix) matches  Ian Lynagh committed Aug 30, 2008 500  ; let fvs' = trim fvs  simonpj committed Aug 10, 2005 501   simonpj@microsoft.com committed Jan 07, 2010 502  ; when is_infix $checkPrecMatch plain_name matches'  simonpj committed Aug 10, 2005 503   Ian Lynagh committed Sep 04, 2008 504  ; fvs' seq -- See Note [Free-variable space leak]  simonpj@microsoft.com committed Jan 07, 2010 505 506 507 508 509 510 511  return (L loc (FunBind { fun_id = name, fun_infix = is_infix, fun_matches = matches', bind_fvs = fvs', fun_co_fn = idHsWrapper, fun_tick = Nothing }),  Dan Licata committed Oct 10, 2007 512 513  [plain_name], fvs) }  Ian Lynagh committed May 03, 2008 514 515  rnBind _ _ b = pprPanic "rnBind" (ppr b)  Ian Lynagh committed Sep 04, 2008 516 517 518 519 520 521 522 523 524 525 526 527 528 529  {- Note [Free-variable space leak] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We have fvs' = trim fvs and we seq fvs' before turning it as part of a record. The reason is that trim is sometimes something like \xs -> intersectNameSet (mkNameSet bound_names) xs and we don't want to retain the list bound_names. This showed up in trac ticket #1136. -}  simonpj committed Aug 10, 2005 530 531 532 --------------------- depAnalBinds :: Bag (LHsBind Name, [Name], Uses) -> ([(RecFlag, LHsBinds Name)], DefUses)  simonpj committed Aug 11, 2005 533 534 -- Dependency analysis; this is important so that -- unused-binding reporting is accurate  simonpj committed Aug 10, 2005 535 536 537 depAnalBinds binds_w_dus = (map get_binds sccs, map get_du sccs) where  batterseapower committed Jul 31, 2008 538  sccs = stronglyConnCompFromEdgedVertices edges  simonpj committed Aug 10, 2005 539 540 541  keyd_nodes = bagToList binds_w_dus zip [0::Int ..]  Simon Marlow committed Mar 02, 2006 542 543  edges = [ (node, key, [key | n <- nameSetToList uses, Just key <- [lookupNameEnv key_map n] ])  simonpj committed Aug 10, 2005 544  | (node@(_,_,uses), key) <- keyd_nodes ]  simonpj committed Jul 19, 2005 545   simonpj committed Aug 10, 2005 546 547 548  key_map :: NameEnv Int -- Which binding it comes from key_map = mkNameEnv [(bndr, key) | ((_, bndrs, _), key) <- keyd_nodes , bndr <- bndrs ]  simonpj committed Jul 19, 2005 549   simonpj committed Aug 10, 2005 550  get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)  Ian Lynagh committed May 03, 2008 551  get_binds (CyclicSCC binds_w_dus) = (Recursive, listToBag [b | (b,_,_) <- binds_w_dus])  simonpj committed Jul 19, 2005 552   simonpj committed Aug 10, 2005 553 554 555 556 557  get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses) get_du (CyclicSCC binds_w_dus) = (Just defs, uses) where defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs] uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]  simonpj committed Jul 19, 2005 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577  --------------------- -- Bind the top-level forall'd type variables in the sigs. -- E.g f :: a -> a -- f = rhs -- The 'a' scopes over the rhs -- -- NB: there'll usually be just one (for a function binding) -- but if there are many, one may shadow the rest; too bad! -- e.g x :: [a] -> [a] -- y :: [(a,a)] -> a -- (x,y) = e -- In e, 'a' will be in scope, and it'll be the one from 'y'! mkSigTvFn :: [LSig Name] -> (Name -> [Name]) -- Return a lookup function that maps an Id Name to the names -- of the type variables that should scope over its body.. mkSigTvFn sigs = \n -> lookupNameEnv env n orElse []  simonpj committed May 25, 2000 578  where  simonpj committed Jul 19, 2005 579 580  env :: NameEnv [Name] env = mkNameEnv [ (name, map hsLTyVarName ltvs)  simonpj committed Oct 27, 2005 581 582  | L _ (TypeSig (L _ name) (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]  simonpj committed Jul 19, 2005 583 584  -- Note the pattern-match on "Explicit"; we only bind -- type variables from signatures with an explicit top-level for-all  simonmar committed Jun 17, 1999 585 586 587 588 \end{code} @rnMethodBinds@ is used for the method bindings of a class and an instance  simonmar committed Dec 10, 2003 589 declaration. Like @rnBinds@ but without dependency analysis.  simonmar committed Jun 17, 1999 590 591 592 593 594 595 596 597 598 599 600 601 602 603  NOTA BENE: we record each {\em binder} of a method-bind group as a free variable. That's crucial when dealing with an instance decl: \begin{verbatim} instance Foo (T a) where op x = ... \end{verbatim} This might be the {\em sole} occurrence of @op@ for an imported class @Foo@, and unless @op@ occurs we won't treat the type signature of @op@ in the class decl for @Foo@ as a source of instance-decl gates. But we should! Indeed, in many ways the @op@ in an instance decl is just like an occurrence, not a binder. \begin{code}  simonpj committed Dec 06, 2001 604 rnMethodBinds :: Name -- Class name  simonpj@microsoft.com committed Jun 12, 2006 605  -> (Name -> [Name]) -- Signature tyvar function  simonpj committed Dec 06, 2001 606  -> [Name] -- Names for generic type variables  simonpj committed Sep 30, 2004 607  -> LHsBinds RdrName  simonmar committed Dec 10, 2003 608  -> RnM (LHsBinds Name, FreeVars)  simonmar committed Jun 17, 1999 609   simonpj@microsoft.com committed Jun 12, 2006 610 rnMethodBinds cls sig_fn gen_tyvars binds  simonmar committed Dec 10, 2003 611 612  = foldM do_one (emptyBag,emptyFVs) (bagToList binds) where do_one (binds,fvs) bind = do  simonpj@microsoft.com committed Jun 12, 2006 613  (bind', fvs_bind) <- rnMethodBind cls sig_fn gen_tyvars bind  simonmar committed Dec 10, 2003 614  return (bind' unionBags binds, fvs_bind plusFV fvs)  simonmar committed Jun 17, 1999 615   Ian Lynagh committed May 03, 2008 616 617 618 619 620 rnMethodBind :: Name -> (Name -> [Name]) -> [Name] -> LHsBindLR RdrName RdrName -> RnM (Bag (LHsBindLR Name Name), FreeVars)  simonpj@microsoft.com committed Jan 07, 2010 621 rnMethodBind cls sig_fn gen_tyvars (L loc (FunBind { fun_id = name, fun_infix = is_infix,  simonpj@microsoft.com committed Jun 12, 2006 622  fun_matches = MatchGroup matches _ }))  twanvl committed Jan 17, 2008 623  = setSrcSpan loc$ do  simonpj@microsoft.com committed Aug 20, 2009 624  sel_name <- wrapLocM (lookupInstDeclBndr cls) name  twanvl committed Jan 17, 2008 625 626 627  let plain_name = unLoc sel_name -- We use the selector name as the binder  simonpj@microsoft.com committed Jan 07, 2010 628 629 630  (new_matches, fvs) <- bindSigTyVarsFV (sig_fn plain_name) $mapFvRn (rn_match (FunRhs plain_name is_infix)) matches let new_group = MatchGroup new_matches placeHolderType  twanvl committed Jan 17, 2008 631   simonpj@microsoft.com committed Jan 07, 2010 632 633 634  when is_infix$ checkPrecMatch plain_name new_group return (unitBag (L loc (FunBind { fun_id = sel_name, fun_infix = is_infix,  twanvl committed Jan 17, 2008 635 636 637 638 639  fun_matches = new_group, bind_fvs = fvs, fun_co_fn = idHsWrapper, fun_tick = Nothing })), fvs addOneFV plain_name) -- The 'fvs' field isn't used for method binds  simonpj committed Oct 03, 2000 640  where  simonpj committed Sep 30, 2004 641 642  -- Truly gruesome; bring into scope the correct members of the generic -- type variables. See comments in RnSource.rnSourceDecl(ClassDecl)  simonpj@microsoft.com committed Jan 07, 2010 643  rn_match info match@(L _ (Match (L _ (TypePat ty) : _) _ _))  simonpj committed Sep 27, 2002 644  = extendTyVarEnvFVRn gen_tvs $ simonpj@microsoft.com committed Jan 07, 2010 645  rnMatch info match  simonpj committed Oct 03, 2000 646  where  simonmar committed Dec 10, 2003 647  tvs = map (rdrNameOcc.unLoc) (extractHsTyRdrTyVars ty)  simonpj committed Oct 03, 2000 648 649  gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv elem tvs]  simonpj@microsoft.com committed Jan 07, 2010 650  rn_match info match = rnMatch info match  simonmar committed Jun 17, 1999 651 652  -- Can't handle method pattern-bindings which bind multiple methods.  simonpj@microsoft.com committed Nov 05, 2009 653 654 rnMethodBind _ _ _ (L loc bind@(PatBind {})) = do addErrAt loc (methodBindErr bind)  twanvl committed Jan 17, 2008 655  return (emptyBag, emptyFVs)  Ian Lynagh committed May 03, 2008 656 657  rnMethodBind _ _ _ b = pprPanic "rnMethodBind" (ppr b)  simonmar committed Jun 17, 1999 658 659 660 \end{code}  chak@cse.unsw.edu.au. committed Sep 15, 2006 661   simonmar committed Jun 17, 1999 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 %************************************************************************ %* * \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)} %* * %************************************************************************ @renameSigs@ checks for: \begin{enumerate} \item more than one sig for one thing; \item signatures given for things not bound here; \end{enumerate} % At the moment we don't gather free-var info from the types in signatures. We'd only need this if we wanted to report unused tyvars. \begin{code}  simonpj@microsoft.com committed May 20, 2008 678 679 680 681 renameSigs :: Maybe NameSet -- If (Just ns) complain if the sig isn't for one of ns -> (Sig RdrName -> Bool) -- Complain about the wrong kind of signature if this is False -> [LSig RdrName] -> RnM [LSig Name]  simonpj committed Jul 19, 2005 682 -- Renames the signatures and performs error checks  simonpj@microsoft.com committed May 20, 2008 683 684 685 686 687 688 renameSigs mb_names ok_sig sigs = do { let (good_sigs, bad_sigs) = partition (ok_sig . unLoc) sigs ; mapM_ unknownSigErr bad_sigs -- Misplaced ; mapM_ dupSigDeclErr (findDupsEq eqHsSig sigs) -- Duplicate ; sigs' <- mapM (wrapLocM (renameSig mb_names)) good_sigs ; return sigs' }  simonpj committed Jul 19, 2005 689 690  ----------------------  simonpj@microsoft.com committed May 20, 2008 691 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory  simonmar committed Jun 17, 1999 692 693 694 695 696 697 698 699 -- because this won't work for: -- instance Foo T where -- {-# INLINE op #-} -- Baz.op = ... -- We'll just rename the INLINE prag to refer to whatever other 'op' -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.) -- Doesn't seem worth much trouble to sort this.  simonpj@microsoft.com committed May 20, 2008 700 701 renameSig :: Maybe NameSet -> Sig RdrName -> RnM (Sig Name) -- FixitySig is renamed elsewhere.  simonpj@microsoft.com committed Jan 02, 2009 702 703 renameSig _ (IdSig x) = return (IdSig x) -- Actually this never occurs  simonpj@microsoft.com committed May 20, 2008 704 renameSig mb_names sig@(TypeSig v ty)  simonpj@microsoft.com committed Oct 27, 2008 705  = do { new_v <- lookupSigOccRn mb_names sig v  simonpj@microsoft.com committed May 20, 2008 706 707 708 709 710 711 712 713  ; new_ty <- rnHsSigType (quotes (ppr v)) ty ; return (TypeSig new_v new_ty) } renameSig _ (SpecInstSig ty) = do { new_ty <- rnLHsType (text "A SPECIALISE instance pragma") ty ; return (SpecInstSig new_ty) } renameSig mb_names sig@(SpecSig v ty inl)  simonpj@microsoft.com committed Oct 27, 2008 714  = do { new_v <- lookupSigOccRn mb_names sig v  simonpj@microsoft.com committed May 20, 2008 715 716 717 718  ; new_ty <- rnHsSigType (quotes (ppr v)) ty ; return (SpecSig new_v new_ty inl) } renameSig mb_names sig@(InlineSig v s)  simonpj@microsoft.com committed Oct 27, 2008 719  = do { new_v <- lookupSigOccRn mb_names sig v  simonpj@microsoft.com committed May 20, 2008 720 721 722  ; return (InlineSig new_v s) } renameSig mb_names sig@(FixSig (FixitySig v f))  simonpj@microsoft.com committed Oct 27, 2008 723  = do { new_v <- lookupSigOccRn mb_names sig v  simonpj@microsoft.com committed May 20, 2008 724  ; return (FixSig (FixitySig new_v f)) }  simonmar committed Jun 17, 1999 725 726 727 \end{code}  Thomas Schilling committed Jul 20, 2008 728 729 %************************************************************************ %* *  simonpj committed Jul 19, 2005 730 \subsection{Match}  Thomas Schilling committed Jul 20, 2008 731 732 %* * %************************************************************************  simonpj committed Jul 19, 2005 733 734 735  \begin{code} rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)  simonpj@microsoft.com committed Aug 11, 2008 736 737 738 rnMatchGroup ctxt (MatchGroup ms _) = do { (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt) ms ; return (MatchGroup new_ms placeHolderType, ms_fvs) }  simonpj committed Jul 19, 2005 739 740 741 742  rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars) rnMatch ctxt = wrapLocFstM (rnMatch' ctxt)  Ian Lynagh committed May 03, 2008 743 rnMatch' :: HsMatchContext Name -> Match RdrName -> RnM (Match Name, FreeVars)  simonpj@microsoft.com committed Jun 04, 2008 744 745 746 747 rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss) = do { -- Result type signatures are no longer supported case maybe_rhs_sig of Nothing -> return ()  simonpj@microsoft.com committed Nov 05, 2009 748  Just (L loc ty) -> addErrAt loc (resSigErr ctxt match ty)  simonpj@microsoft.com committed Jun 04, 2008 749 750 751  -- Now the main event -- note that there are no local ficity decls for matches  simonpj@microsoft.com committed Aug 20, 2009 752  ; rnPats ctxt pats$ \ pats' -> do  simonpj@microsoft.com committed Jun 04, 2008 753 754 755  { (grhss', grhss_fvs) <- rnGRHSs ctxt grhss ; return (Match pats' Nothing grhss', grhss_fvs) }}  simonpj committed Jul 19, 2005 756  -- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs  simonpj@microsoft.com committed Jun 04, 2008 757 758 759 760 761 762  resSigErr :: HsMatchContext Name -> Match RdrName -> HsType RdrName -> SDoc resSigErr ctxt match ty = vcat [ ptext (sLit "Illegal result type signature") <+> quotes (ppr ty) , nest 2 $ptext (sLit "Result signatures are no longer supported in pattern matches") , pprMatchInCtxt ctxt match ]  simonpj committed Jul 19, 2005 763 764 765 766 767 768 769 770 771 772 773 774 775 \end{code} %************************************************************************ %* * \subsubsection{Guarded right-hand sides (GRHSs)} %* * %************************************************************************ \begin{code} rnGRHSs :: HsMatchContext Name -> GRHSs RdrName -> RnM (GRHSs Name, FreeVars) rnGRHSs ctxt (GRHSs grhss binds)  twanvl committed Jan 17, 2008 776 777 778  = rnLocalBindsAndThen binds$ \ binds' -> do (grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt) grhss return (GRHSs grhss' binds', fvGRHSs)  simonpj committed Jul 19, 2005 779 780 781 782  rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars) rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)  Ian Lynagh committed May 03, 2008 783 rnGRHS' :: HsMatchContext Name -> GRHS RdrName -> RnM (GRHS Name, FreeVars)  simonpj committed Jul 19, 2005 784 rnGRHS' ctxt (GRHS guards rhs)  Ian Lynagh committed Jul 08, 2007 785  = do { pattern_guards_allowed <- doptM Opt_PatternGuards  simonpj committed Jul 19, 2005 786 787  ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $rnLExpr rhs  simonpj@microsoft.com committed Feb 06, 2006 788   twanvl committed Jan 17, 2008 789  ; unless (pattern_guards_allowed || is_standard_guard guards')  simonpj@microsoft.com committed Feb 06, 2006 790 791  (addWarn (nonStdGuardErr guards'))  simonpj committed Jul 19, 2005 792 793 794 795 796 797 798  ; return (GRHS guards' rhs', fvs) } where -- Standard Haskell 1.4 guards are just a single boolean -- expression, rather than a list of qualifiers as in the -- Glasgow extension is_standard_guard [] = True is_standard_guard [L _ (ExprStmt _ _ _)] = True  Ian Lynagh committed May 03, 2008 799  is_standard_guard _ = False  simonpj committed Jul 19, 2005 800 801 \end{code}  simonmar committed Jun 17, 1999 802 803 804 805 806 807 808 %************************************************************************ %* * \subsection{Error messages} %* * %************************************************************************ \begin{code}  simonpj@microsoft.com committed May 20, 2008 809 dupSigDeclErr :: [LSig RdrName] -> RnM ()  simonpj committed Jul 19, 2005 810 dupSigDeclErr sigs@(L loc sig : _)  simonmar committed Dec 10, 2003 811  = addErrAt loc$  Ian Lynagh committed Apr 12, 2008 812  vcat [ptext (sLit "Duplicate") <+> what_it_is <> colon,  simonpj committed Jul 19, 2005 813  nest 2 (vcat (map ppr_sig sigs))]  simonmar committed Jun 17, 1999 814  where  simonmar committed Dec 10, 2003 815 816  what_it_is = hsSigDoc sig ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig  Ian Lynagh committed May 03, 2008 817 dupSigDeclErr [] = panic "dupSigDeclErr"  simonmar committed Jun 17, 1999 818   simonpj@microsoft.com committed May 20, 2008 819 unknownSigErr :: LSig RdrName -> RnM ()  simonmar committed Dec 10, 2003 820 unknownSigErr (L loc sig)  simonpj@microsoft.com committed May 20, 2008 821 822  = addErrAt loc \$ sep [ptext (sLit "Misplaced") <+> hsSigDoc sig <> colon, ppr sig]  simonmar committed Jun 17, 1999 823   Ian Lynagh committed May 03, 2008 824 methodBindErr :: HsBindLR RdrName RdrName -> SDoc  simonmar committed Jun 17, 1999 825 methodBindErr mbind  Ian Lynagh committed Apr 12, 2008 826  = hang (ptext (sLit "Pattern bindings (except simple variables) not allowed in instance declarations"))  simonpj committed Jan 27, 2005 827 828  2 (ppr mbind)  Ian Lynagh committed May 03, 2008 829 bindsInHsBootFile :: LHsBindsLR Name RdrName -> SDoc  simonpj committed Jan 27, 2005 830 bindsInHsBootFile mbinds  Ian Lynagh committed Apr 12, 2008 831  = hang (ptext (sLit "Bindings in hs-boot files are not allowed"))  simonpj committed Jan 27, 2005 832  2 (ppr mbinds)  simonpj committed Jul 19, 2005 833   Ian Lynagh committed May 03, 2008 834 nonStdGuardErr :: [LStmtLR Name Name] -> SDoc  simonpj@microsoft.com committed Feb 06, 2006 835 nonStdGuardErr guards  Ian Lynagh committed Apr 12, 2008 836  = hang (ptext (sLit "accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))  simonpj@microsoft.com committed Feb 06, 2006 837  4 (interpp'SP guards)  simonmar committed Jun 17, 1999 838 \end{code}