ghc/compiler/typecheck/TcModule.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[TcModule]{Typechecking a whole module}
   5
   6 \begin{code}
   7 module TcModule (
   8         typecheckModule, typecheckExpr, TcResults(..)
   9     ) where
  10
  11 #include "HsVersions.h"
  12
  13 import CmdLineOpts      ( DynFlag(..), DynFlags, opt_PprStyle_Debug )
  14 import HsSyn            ( HsBinds(..), MonoBinds(..), HsDecl(..), HsExpr(..),
  15                           isIfaceRuleDecl, nullBinds, andMonoBindList
  16                         )
  17 import HsTypes          ( toHsType )
  18 import PrelNames        ( SyntaxMap, mAIN_Name, mainName, ioTyConName, printName )
  19 import RnHsSyn          ( RenamedHsBinds, RenamedHsDecl, RenamedHsExpr )
  20 import TcHsSyn          ( TypecheckedMonoBinds, TypecheckedHsExpr,
  21                           TypecheckedForeignDecl, TypecheckedRuleDecl,
  22                           zonkTopBinds, zonkForeignExports, zonkRules, mkHsLet,
  23                           zonkExpr
  24                         )
  25
  26
  27 import TcMonad
  28 import TcType           ( newTyVarTy, zonkTcType, tcInstType )
  29 import TcUnify          ( unifyTauTy )
  30 import Inst             ( plusLIE )
  31 import VarSet           ( varSetElems )
  32 import TcBinds          ( tcTopBinds )
  33 import TcClassDcl       ( tcClassDecls2 )
  34 import TcDefaults       ( tcDefaults, defaultDefaultTys )
  35 import TcExpr           ( tcMonoExpr )
  36 import TcEnv            ( TcEnv, RecTcEnv, InstInfo, tcExtendGlobalValEnv, tcLookup_maybe,
  37                           isLocalThing, tcSetEnv, tcSetInstEnv, initTcEnv, getTcGEnv,
  38                           TcTyThing(..), tcLookupTyCon
  39                         )
  40 import TcRules          ( tcIfaceRules, tcSourceRules )
  41 import TcForeign        ( tcForeignImports, tcForeignExports )
  42 import TcIfaceSig       ( tcInterfaceSigs )
  43 import TcInstDcls       ( tcInstDecls1, tcInstDecls2 )
  44 import TcSimplify       ( tcSimplifyTop, tcSimplifyInfer )
  45 import TcTyClsDecls     ( tcTyAndClassDecls )
  46
  47 import CoreUnfold       ( unfoldingTemplate, hasUnfolding )
  48 import Type             ( funResultTy, splitForAllTys, mkForAllTys, mkFunTys,
  49                           liftedTypeKind, openTypeKind, mkTyConApp, tyVarsOfType, tidyType )
  50 import ErrUtils         ( printErrorsAndWarnings, errorsFound, dumpIfSet_dyn, showPass )
  51 import Id               ( idType, idName, isLocalId, idUnfolding )
  52 import Module           ( Module, isHomeModule, moduleName )
  53 import Name             ( Name, toRdrName, isGlobalName )
  54 import Name             ( nameEnvElts, lookupNameEnv )
  55 import TyCon            ( tyConGenInfo )
  56 import Util
  57 import BasicTypes       ( EP(..), Fixity )
  58 import Outputable
  59 import HscTypes         ( PersistentCompilerState(..), HomeSymbolTable,
  60                           PackageTypeEnv, ModIface(..),
  61                           TypeEnv, extendTypeEnvList,
  62                           TyThing(..), implicitTyThingIds,
  63                           mkTypeEnv
  64                         )
  65 \end{code}
  66
  67 Outside-world interface:
  68 \begin{code}
  69
  70 -- Convenient type synonyms first:
  71 data TcResults
  72   = TcResults {
  73         -- All these fields have info *just for this module*
  74         tc_env     :: TypeEnv,                  -- The top level TypeEnv
  75         tc_binds   :: TypecheckedMonoBinds,     -- Bindings
  76         tc_fords   :: [TypecheckedForeignDecl], -- Foreign import & exports.
  77         tc_rules   :: [TypecheckedRuleDecl]     -- Transformation rules
  78     }
  79
  80 ---------------
  81 typecheckModule
  82         :: DynFlags
  83         -> PersistentCompilerState
  84         -> HomeSymbolTable
  85         -> ModIface             -- Iface for this module
  86         -> PrintUnqualified     -- For error printing
  87         -> (SyntaxMap, [RenamedHsDecl])
  88         -> Bool                 -- True <=> check for Main.main if Module==Main
  89         -> IO (Maybe (PersistentCompilerState, TcResults))
  90                         -- The new PCS is Augmented with imported information,
  91                                                 -- (but not stuff from this module)
  92
  93
  94 typecheckModule dflags pcs hst mod_iface unqual (syn_map, decls) check_main
  95   = do  { maybe_tc_result <- typecheck dflags syn_map pcs hst unqual $
  96                              tcModule pcs hst get_fixity this_mod decls check_main
  97         ; printTcDump dflags maybe_tc_result
  98         ; return maybe_tc_result }
  99   where
 100     this_mod   = mi_module   mod_iface
 101     fixity_env = mi_fixities mod_iface
 102
 103     get_fixity :: Name -> Maybe Fixity
 104     get_fixity nm = lookupNameEnv fixity_env nm
 105
 106 ---------------
 107 typecheckExpr :: DynFlags
 108               -> Bool                   -- True <=> wrap in 'print' to get a result of IO type
 109               -> PersistentCompilerState
 110               -> HomeSymbolTable
 111               -> PrintUnqualified       -- For error printing
 112               -> Module
 113               -> (SyntaxMap,
 114                   RenamedHsExpr,        -- The expression itself
 115                   [RenamedHsDecl])      -- Plus extra decls it sucked in from interface files
 116               -> IO (Maybe (PersistentCompilerState, TypecheckedHsExpr, TcType))
 117
 118 typecheckExpr dflags wrap_io pcs hst unqual this_mod (syn_map, expr, decls)
 119   = typecheck dflags syn_map pcs hst unqual $
 120
 121          -- use the default default settings, i.e. [Integer, Double]
 122     tcSetDefaultTys defaultDefaultTys $
 123
 124         -- Typecheck the extra declarations
 125     fixTc (\ ~(unf_env, _, _, _, _) ->
 126         tcImports unf_env pcs hst get_fixity this_mod decls
 127     )                   `thenTc` \ (env, new_pcs, local_inst_info, deriv_binds, local_rules) ->
 128     ASSERT( null local_inst_info && nullBinds deriv_binds && null local_rules )
 129
 130         -- Now typecheck the expression
 131     tcSetEnv env                                $
 132     tc_expr expr                                        `thenTc` \ (expr', expr_ty) ->
 133     zonkExpr expr'                                      `thenNF_Tc` \ zonked_expr ->
 134     zonkTcType expr_ty                                  `thenNF_Tc` \ zonked_ty ->
 135     ioToTc (dumpIfSet_dyn dflags
 136                 Opt_D_dump_tc "Typechecked" (ppr zonked_expr)) `thenNF_Tc_`
 137     returnTc (new_pcs, zonked_expr, zonked_ty)
 138
 139   where
 140     get_fixity :: Name -> Maybe Fixity
 141     get_fixity n = pprPanic "typecheckExpr" (ppr n)
 142
 143     smpl_doc = ptext SLIT("main expression")
 144
 145         -- Typecheck it, wrapping in 'print' if necessary to
 146         -- get a result of type IO t.  Returns the result type
 147         -- that is free in the result type
 148     tc_expr e
 149         | wrap_io   = tryTc_ (tc_io_expr (HsApp (HsVar printName) e))   -- Recovery case
 150                              (tc_io_expr e)                             -- Main case
 151         | otherwise = newTyVarTy openTypeKind   `thenTc` \ ty ->
 152                       tcMonoExpr e ty           `thenTc` \ (e', lie) ->
 153                       tcSimplifyInfer smpl_doc (varSetElems (tyVarsOfType ty)) lie
 154                                 `thenTc` \ (qtvs, lie_free, dict_binds, dict_ids) ->
 155                       tcSimplifyTop lie_free    `thenTc` \ const_binds ->
 156                       let all_expr = mkHsLet const_binds        $
 157                                      TyLam qtvs                 $
 158                                      DictLam dict_ids           $
 159                                      mkHsLet dict_binds         $
 160                                      e'
 161                           all_expr_ty = mkForAllTys qtvs        $
 162                                         mkFunTys (map idType dict_ids) $
 163                                         ty
 164                       in
 165                       returnTc (all_expr, all_expr_ty)
 166         where
 167           tc_io_expr e = newTyVarTy openTypeKind        `thenTc` \ ty ->
 168                          tcLookupTyCon ioTyConName      `thenNF_Tc` \ ioTyCon ->
 169                          let
 170                             res_ty = mkTyConApp ioTyCon [ty]
 171                          in
 172                          tcMonoExpr e res_ty    `thenTc` \ (e', lie) ->
 173                          tcSimplifyTop lie      `thenTc` \ const_binds ->
 174                          let all_expr = mkHsLet const_binds e' in
 175                          returnTc (all_expr, res_ty)
 176
 177 ---------------
 178 typecheck :: DynFlags
 179           -> SyntaxMap
 180           -> PersistentCompilerState
 181           -> HomeSymbolTable
 182           -> PrintUnqualified   -- For error printing
 183           -> TcM r
 184           -> IO (Maybe r)
 185
 186 typecheck dflags syn_map pcs hst unqual thing_inside
 187  = do   { showPass dflags "Typechecker";
 188         ; env <- initTcEnv syn_map hst (pcs_PTE pcs)
 189
 190         ; (maybe_tc_result, errs) <- initTc dflags env thing_inside
 191
 192         ; printErrorsAndWarnings unqual errs
 193
 194         ; if errorsFound errs then
 195              return Nothing
 196            else
 197              return maybe_tc_result
 198         }
 199 \end{code}
 200
 201 The internal monster:
 202 \begin{code}
 203 tcModule :: PersistentCompilerState
 204          -> HomeSymbolTable
 205          -> (Name -> Maybe Fixity)
 206          -> Module
 207          -> [RenamedHsDecl]
 208          -> Bool                        -- True <=> check for Main.main if Mod==Main
 209          -> TcM (PersistentCompilerState, TcResults)
 210
 211 tcModule pcs hst get_fixity this_mod decls check_main
 212   = fixTc (\ ~(unf_env, _, _) ->
 213                 -- Loop back the final environment, including the fully zonkec
 214                 -- versions of bindings from this module.  In the presence of mutual
 215                 -- recursion, interface type signatures may mention variables defined
 216                 -- in this module, which is why the knot is so big
 217
 218                 -- Type-check the type and class decls, and all imported decls
 219         tcImports unf_env pcs hst get_fixity this_mod decls
 220                                 `thenTc` \ (env, new_pcs, local_insts, deriv_binds, local_rules) ->
 221
 222         tcSetEnv env                            $
 223
 224         -- Foreign import declarations next
 225         traceTc (text "Tc4")                    `thenNF_Tc_`
 226         tcForeignImports decls                  `thenTc`    \ (fo_ids, foi_decls) ->
 227         tcExtendGlobalValEnv fo_ids             $
 228
 229         -- Default declarations
 230         tcDefaults decls                        `thenTc` \ defaulting_tys ->
 231         tcSetDefaultTys defaulting_tys          $
 232
 233         -- Value declarations next.
 234         -- We also typecheck any extra binds that came out of the "deriving" process
 235         traceTc (text "Default types" <+> ppr defaulting_tys)   `thenNF_Tc_`
 236         traceTc (text "Tc5")                            `thenNF_Tc_`
 237         tcTopBinds (val_binds `ThenBinds` deriv_binds)  `thenTc` \ ((val_binds, env), lie_valdecls) ->
 238
 239         -- Second pass over class and instance declarations,
 240         -- plus rules and foreign exports, to generate bindings
 241         tcSetEnv env                            $
 242         tcInstDecls2  local_insts               `thenNF_Tc` \ (lie_instdecls, inst_binds) ->
 243         tcClassDecls2 this_mod tycl_decls       `thenNF_Tc` \ (lie_clasdecls, cls_dm_binds) ->
 244         tcForeignExports decls                  `thenTc`    \ (lie_fodecls,   foe_binds, foe_decls) ->
 245         tcSourceRules source_rules              `thenNF_Tc` \ (lie_rules,     more_local_rules) ->
 246
 247              -- Deal with constant or ambiguous InstIds.  How could
 248              -- there be ambiguous ones?  They can only arise if a
 249              -- top-level decl falls under the monomorphism
 250              -- restriction, and no subsequent decl instantiates its
 251              -- type.  (Usually, ambiguous type variables are resolved
 252              -- during the generalisation step.)
 253         let
 254             lie_alldecls = lie_valdecls  `plusLIE`
 255                            lie_instdecls `plusLIE`
 256                            lie_clasdecls `plusLIE`
 257                            lie_fodecls   `plusLIE`
 258                            lie_rules
 259         in
 260         traceTc (text "Tc6")                            `thenNF_Tc_`
 261         tcSimplifyTop lie_alldecls                      `thenTc` \ const_inst_binds ->
 262
 263                 -- CHECK THAT main IS DEFINED WITH RIGHT TYPE, IF REQUIRED
 264         (if check_main
 265                 then tcCheckMain this_mod
 266                 else returnTc ())               `thenTc_`
 267
 268             -- Backsubstitution.    This must be done last.
 269             -- Even tcSimplifyTop may do some unification.
 270         let
 271             all_binds = val_binds               `AndMonoBinds`
 272                             inst_binds          `AndMonoBinds`
 273                             cls_dm_binds        `AndMonoBinds`
 274                             const_inst_binds    `AndMonoBinds`
 275                             foe_binds
 276         in
 277         traceTc (text "Tc7")            `thenNF_Tc_`
 278         zonkTopBinds all_binds          `thenNF_Tc` \ (all_binds', final_env)  ->
 279         tcSetEnv final_env              $
 280                 -- zonkTopBinds puts all the top-level Ids into the tcGEnv
 281         traceTc (text "Tc8")            `thenNF_Tc_`
 282         zonkForeignExports foe_decls    `thenNF_Tc` \ foe_decls' ->
 283         traceTc (text "Tc9")            `thenNF_Tc_`
 284         zonkRules more_local_rules      `thenNF_Tc` \ more_local_rules' ->
 285
 286
 287         let     local_things = filter (isLocalThing this_mod) (nameEnvElts (getTcGEnv final_env))
 288
 289                 -- Create any necessary "implicit" bindings (data constructors etc)
 290                 -- Should we create bindings for dictionary constructors?
 291                 -- They are always fully applied, and the bindings are just there
 292                 -- to support partial applications. But it's easier to let them through.
 293                 implicit_binds = andMonoBindList [ CoreMonoBind id (unfoldingTemplate unf)
 294                                                  | id <- implicitTyThingIds local_things
 295                                                  , let unf = idUnfolding id
 296                                                  , hasUnfolding unf
 297                                                  ]
 298
 299                 local_type_env :: TypeEnv
 300                 local_type_env = mkTypeEnv local_things
 301
 302                 all_local_rules = local_rules ++ more_local_rules'
 303         in
 304         traceTc (text "Tc10")           `thenNF_Tc_`
 305         returnTc (final_env,
 306                   new_pcs,
 307                   TcResults { tc_env     = local_type_env,
 308                               tc_binds   = implicit_binds `AndMonoBinds` all_binds',
 309                               tc_fords   = foi_decls ++ foe_decls',
 310                               tc_rules   = all_local_rules
 311                             }
 312         )
 313     )                   `thenTc` \ (_, pcs, tc_result) ->
 314     returnTc (pcs, tc_result)
 315   where
 316     tycl_decls   = [d | TyClD d <- decls]
 317     val_binds    = foldr ThenBinds EmptyBinds [binds | ValD binds <- decls]
 318     source_rules = [d | RuleD d <- decls, not (isIfaceRuleDecl d)]
 319 \end{code}
 320
 321
 322 \begin{code}
 323 tcImports :: RecTcEnv
 324           -> PersistentCompilerState
 325           -> HomeSymbolTable
 326           -> (Name -> Maybe Fixity)
 327           -> Module
 328           -> [RenamedHsDecl]
 329           -> TcM (TcEnv, PersistentCompilerState, [InstInfo],
 330                          RenamedHsBinds, [TypecheckedRuleDecl])
 331
 332 -- tcImports is a slight mis-nomer.
 333 -- It deals with everythign that could be an import:
 334 --      type and class decls
 335 --      interface signatures
 336 --      instance decls
 337 --      rule decls
 338 -- These can occur in source code too, of course
 339
 340 tcImports unf_env pcs hst get_fixity this_mod decls
 341           -- (unf_env :: RecTcEnv) is used for type-checking interface pragmas
 342           -- which is done lazily [ie failure just drops the pragma
 343           -- without having any global-failure effect].
 344           --
 345           -- unf_env is also used to get the pragama info
 346           -- for imported dfuns and default methods
 347
 348   = checkNoErrsTc $
 349         -- tcImports recovers internally, but if anything gave rise to
 350         -- an error we'd better stop now, to avoid a cascade
 351
 352     traceTc (text "Tc1")                        `thenNF_Tc_`
 353     tcTyAndClassDecls unf_env tycl_decls        `thenTc` \ env ->
 354     tcSetEnv env                                $
 355
 356         -- Typecheck the instance decls, includes deriving
 357     traceTc (text "Tc2")        `thenNF_Tc_`
 358     tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs)
 359              hst unf_env get_fixity this_mod
 360              decls                      `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
 361     tcSetInstEnv inst_env                       $
 362
 363     -- Interface type signatures
 364     -- We tie a knot so that the Ids read out of interfaces are in scope
 365     --   when we read their pragmas.
 366     -- What we rely on is that pragmas are typechecked lazily; if
 367     --   any type errors are found (ie there's an inconsistency)
 368     --   we silently discard the pragma
 369     traceTc (text "Tc3")                        `thenNF_Tc_`
 370     tcInterfaceSigs unf_env tycl_decls          `thenTc` \ sig_ids ->
 371     tcExtendGlobalValEnv sig_ids                $
 372
 373
 374     tcIfaceRules (pcs_rules pcs) this_mod iface_rules   `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
 375         -- When relinking this module from its interface-file decls
 376         -- we'll have IfaceRules that are in fact local to this module
 377         -- That's the reason we we get any local_rules out here
 378
 379     tcGetEnv                                            `thenTc` \ unf_env ->
 380     let
 381         all_things = nameEnvElts (getTcGEnv unf_env)
 382
 383          -- sometimes we're compiling in the context of a package module
 384          -- (on the GHCi command line, for example).  In this case, we
 385          -- want to treat everything we pulled in as an imported thing.
 386         imported_things
 387           | isHomeModule this_mod
 388           = filter (not . isLocalThing this_mod) all_things
 389           | otherwise
 390           = all_things
 391
 392         new_pte :: PackageTypeEnv
 393         new_pte = extendTypeEnvList (pcs_PTE pcs) imported_things
 394
 395         new_pcs :: PersistentCompilerState
 396         new_pcs = pcs { pcs_PTE   = new_pte,
 397                         pcs_insts = new_pcs_insts,
 398                         pcs_rules = new_pcs_rules
 399                   }
 400     in
 401     returnTc (unf_env, new_pcs, local_insts, deriv_binds, local_rules)
 402   where
 403     tycl_decls  = [d | TyClD d <- decls]
 404     iface_rules = [d | RuleD d <- decls, isIfaceRuleDecl d]
 405 \end{code}
 406
 407 %************************************************************************
 408 %*                                                                      *
 409 \subsection{Checking the type of main}
 410 %*                                                                      *
 411 %************************************************************************
 412
 413 We must check that in module Main,
 414         a) main is defined
 415         b) main :: forall a1...an. IO t,  for some type t
 416
 417 If we have
 418         main = error "Urk"
 419 then the type of main will be
 420         main :: forall a. a
 421 and that should pass the test too.
 422
 423 So we just instantiate the type and unify with IO t, and declare
 424 victory if doing so succeeds.
 425
 426 \begin{code}
 427 tcCheckMain :: Module -> TcM ()
 428 tcCheckMain this_mod
 429   | not (moduleName this_mod == mAIN_Name )
 430   = returnTc ()
 431
 432   | otherwise
 433   =     -- First unify the main_id with IO t, for any old t
 434     tcLookup_maybe mainName             `thenNF_Tc` \ maybe_thing ->
 435     case maybe_thing of
 436         Just (ATcId main_id) -> check_main_ty (idType main_id)
 437         other                -> addErrTc noMainErr
 438   where
 439     check_main_ty main_ty
 440       = tcInstType main_ty              `thenNF_Tc` \ (tvs, theta, main_tau) ->
 441         newTyVarTy liftedTypeKind       `thenNF_Tc` \ arg_ty ->
 442         tcLookupTyCon ioTyConName       `thenNF_Tc` \ ioTyCon ->
 443         tcAddErrCtxtM (mainTypeCtxt main_ty)    $
 444         if not (null theta) then
 445                 failWithTc empty        -- Context has the error message
 446         else
 447         unifyTauTy main_tau (mkTyConApp ioTyCon [arg_ty])
 448
 449 mainTypeCtxt main_ty tidy_env
 450   = zonkTcType main_ty          `thenNF_Tc` \ main_ty' ->
 451     returnNF_Tc (tidy_env, ptext SLIT("`main' has the illegal type") <+>
 452                                  quotes (ppr (tidyType tidy_env main_ty')))
 453
 454 noMainErr = hsep [ptext SLIT("Module") <+> quotes (ppr mAIN_Name),
 455                   ptext SLIT("must include a definition for") <+> quotes (ptext SLIT("main"))]
 456 \end{code}
 457
 458
 459 %************************************************************************
 460 %*                                                                      *
 461 \subsection{Dumping output}
 462 %*                                                                      *
 463 %************************************************************************
 464
 465 \begin{code}
 466 printTcDump dflags Nothing = return ()
 467 printTcDump dflags (Just (_, results))
 468   = do dumpIfSet_dyn dflags Opt_D_dump_types
 469                      "Type signatures" (dump_sigs results)
 470        dumpIfSet_dyn dflags Opt_D_dump_tc
 471                      "Typechecked" (dump_tc results)
 472
 473 dump_tc results
 474   = vcat [ppr (tc_binds results),
 475           pp_rules (tc_rules results),
 476           ppr_gen_tycons [tc | ATyCon tc <- nameEnvElts (tc_env results)]
 477     ]
 478
 479 dump_sigs results       -- Print type signatures
 480   =     -- Convert to HsType so that we get source-language style printing
 481         -- And sort by RdrName
 482     vcat $ map ppr_sig $ sortLt lt_sig $
 483     [ (toRdrName id, toHsType (idType id))
 484     | AnId id <- nameEnvElts (tc_env results),
 485       want_sig id
 486     ]
 487   where
 488     lt_sig (n1,_) (n2,_) = n1 < n2
 489     ppr_sig (n,t)        = ppr n <+> dcolon <+> ppr t
 490
 491     want_sig id | opt_PprStyle_Debug = True
 492                 | otherwise          = isLocalId id && isGlobalName (idName id)
 493         -- isLocalId ignores data constructors, records selectors etc
 494         -- The isGlobalName ignores local dictionary and method bindings
 495         -- that the type checker has invented.  User-defined things have
 496         -- Global names.
 497
 498 ppr_gen_tycons tcs = vcat [ptext SLIT("{-# Generic type constructor details"),
 499                            vcat (map ppr_gen_tycon tcs),
 500                            ptext SLIT("#-}")
 501                      ]
 502
 503 -- x&y are now Id's, not CoreExpr's
 504 ppr_gen_tycon tycon
 505   | Just ep <- tyConGenInfo tycon
 506   = (ppr tycon <> colon) $$ nest 4 (ppr_ep ep)
 507
 508   | otherwise = ppr tycon <> colon <+> ptext SLIT("Not derivable")
 509
 510 ppr_ep (EP from to)
 511   = vcat [ ptext SLIT("Rep type:") <+> ppr (funResultTy from_tau),
 512            ptext SLIT("From:") <+> ppr (unfoldingTemplate (idUnfolding from)),
 513            ptext SLIT("To:")   <+> ppr (unfoldingTemplate (idUnfolding to))
 514     ]
 515   where
 516     (_,from_tau) = splitForAllTys (idType from)
 517
 518 pp_rules [] = empty
 519 pp_rules rs = vcat [ptext SLIT("{-# RULES"),
 520                     nest 4 (vcat (map ppr rs)),
 521                     ptext SLIT("#-}")]
 522 \end{code}