compiler/main/HscMain.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
   3 %
   4 \begin{code}
   5 -- | Main driver for the compiling plain Haskell source code.
   6 --
   7 -- This module implements compilation of a Haskell-only source file.  It is
   8 -- /not/ concerned with preprocessing of source files; this is handled in
   9 -- "DriverPipeline".
  10 --
  11 module HscMain
  12     ( newHscEnv, hscCmmFile
  13     , hscParseIdentifier
  14     , hscSimplify
  15     , hscNormalIface, hscWriteIface, hscGenHardCode
  16 #ifdef GHCI
  17     , hscStmt, hscTcExpr, hscImport, hscKcType
  18     , compileExpr
  19 #endif
  20     , HsCompiler(..)
  21     , hscOneShotCompiler, hscNothingCompiler
  22     , hscInteractiveCompiler, hscBatchCompiler
  23     , hscCompileOneShot     -- :: Compiler HscStatus
  24     , hscCompileBatch       -- :: Compiler (HscStatus, ModIface, ModDetails)
  25     , hscCompileNothing     -- :: Compiler (HscStatus, ModIface, ModDetails)
  26     , hscCompileInteractive -- :: Compiler (InteractiveStatus, ModIface, ModDetails)
  27     , hscCheckRecompBackend
  28     , HscStatus' (..)
  29     , InteractiveStatus, HscStatus
  30
  31     -- The new interface
  32     , hscParse
  33     , hscTypecheck
  34     , hscTypecheckRename
  35     , hscDesugar
  36     , makeSimpleIface
  37     , makeSimpleDetails
  38     ) where
  39
  40 #ifdef GHCI
  41 import CodeOutput       ( outputForeignStubs )
  42 import ByteCodeGen      ( byteCodeGen, coreExprToBCOs )
  43 import Linker           ( HValue, linkExpr )
  44 import CoreTidy         ( tidyExpr )
  45 import CorePrep         ( corePrepExpr )
  46 import Desugar          ( deSugarExpr )
  47 import SimplCore        ( simplifyExpr )
  48 import TcRnDriver       ( tcRnStmt, tcRnExpr, tcRnType )
  49 import Type             ( Type )
  50 import PrelNames        ( iNTERACTIVE )
  51 import {- Kind parts of -} Type         ( Kind )
  52 import CoreLint         ( lintUnfolding )
  53 import DsMeta           ( templateHaskellNames )
  54 import SrcLoc           ( SrcSpan, noSrcLoc, interactiveSrcLoc, srcLocSpan, noSrcSpan, unLoc )
  55 import VarSet
  56 import VarEnv           ( emptyTidyEnv )
  57 import Panic
  58 #endif
  59
  60 import Id               ( Id )
  61 import Module           ( emptyModuleEnv, ModLocation(..), Module )
  62 import RdrName
  63 import HsSyn
  64 import CoreSyn
  65 import SrcLoc           ( Located(..) )
  66 import StringBuffer
  67 import Parser
  68 import Lexer
  69 import SrcLoc           ( mkSrcLoc )
  70 import TcRnDriver       ( tcRnModule )
  71 import TcIface          ( typecheckIface )
  72 import TcRnMonad        ( initIfaceCheck, TcGblEnv(..) )
  73 import IfaceEnv         ( initNameCache )
  74 import LoadIface        ( ifaceStats, initExternalPackageState )
  75 import PrelInfo         ( wiredInThings, basicKnownKeyNames )
  76 import MkIface
  77 import Desugar          ( deSugar )
  78 import SimplCore        ( core2core )
  79 import TidyPgm
  80 import CorePrep         ( corePrepPgm )
  81 import CoreToStg        ( coreToStg )
  82 import qualified StgCmm ( codeGen )
  83 import StgSyn
  84 import CostCentre
  85 import TyCon            ( TyCon, isDataTyCon )
  86 import Name             ( Name, NamedThing(..) )
  87 import SimplStg         ( stg2stg )
  88 import CodeGen          ( codeGen )
  89 import Cmm              ( Cmm )
  90 import PprCmm           ( pprCmms )
  91 import CmmParse         ( parseCmmFile )
  92 import CmmBuildInfoTables
  93 import CmmCPS
  94 import CmmCPSZ
  95 import CmmInfo
  96 import OptimizationFuel ( initOptFuelState )
  97 import CmmCvt
  98 import CmmTx
  99 import CmmContFlowOpt
 100 import CodeOutput       ( codeOutput )
 101 import NameEnv          ( emptyNameEnv )
 102 import Fingerprint      ( Fingerprint )
 103
 104 import DynFlags
 105 import ErrUtils
 106 import UniqSupply       ( mkSplitUniqSupply )
 107
 108 import Outputable
 109 import HscStats         ( ppSourceStats )
 110 import HscTypes
 111 import MkExternalCore   ( emitExternalCore )
 112 import FastString
 113 import UniqFM           ( emptyUFM )
 114 import UniqSupply       ( initUs_ )
 115 import Bag              ( unitBag )
 116 import Exception
 117 -- import MonadUtils
 118
 119 import Control.Monad
 120 -- import System.IO
 121 import Data.IORef
 122 \end{code}
 123 #include "HsVersions.h"
 124
 125
 126 %************************************************************************
 127 %*                                                                      *
 128                 Initialisation
 129 %*                                                                      *
 130 %************************************************************************
 131
 132 \begin{code}
 133 newHscEnv :: GhcApiCallbacks -> DynFlags -> IO HscEnv
 134 newHscEnv callbacks dflags
 135   = do  { eps_var <- newIORef initExternalPackageState
 136         ; us      <- mkSplitUniqSupply 'r'
 137         ; nc_var  <- newIORef (initNameCache us knownKeyNames)
 138         ; fc_var  <- newIORef emptyUFM
 139         ; mlc_var <- newIORef emptyModuleEnv
 140         ; optFuel <- initOptFuelState
 141         ; return (HscEnv { hsc_dflags = dflags,
 142                            hsc_callbacks = callbacks,
 143                            hsc_targets = [],
 144                            hsc_mod_graph = [],
 145                            hsc_IC      = emptyInteractiveContext,
 146                            hsc_HPT     = emptyHomePackageTable,
 147                            hsc_EPS     = eps_var,
 148                            hsc_NC      = nc_var,
 149                            hsc_FC      = fc_var,
 150                            hsc_MLC     = mlc_var,
 151                            hsc_OptFuel = optFuel,
 152                            hsc_type_env_var = Nothing,
 153                            hsc_global_rdr_env = emptyGlobalRdrEnv,
 154                            hsc_global_type_env = emptyNameEnv } ) }
 155
 156
 157 knownKeyNames :: [Name] -- Put here to avoid loops involving DsMeta,
 158                         -- where templateHaskellNames are defined
 159 knownKeyNames = map getName wiredInThings
 160               ++ basicKnownKeyNames
 161 #ifdef GHCI
 162               ++ templateHaskellNames
 163 #endif
 164 \end{code}
 165
 166
 167 \begin{code}
 168 -- | parse a file, returning the abstract syntax
 169 hscParse :: GhcMonad m =>
 170             ModSummary
 171          -> m (Located (HsModule RdrName))
 172 hscParse mod_summary = do
 173    hsc_env <- getSession
 174    let dflags        = hsc_dflags hsc_env
 175        src_filename  = ms_hspp_file mod_summary
 176        maybe_src_buf = ms_hspp_buf  mod_summary
 177    --------------------------  Parser  ----------------
 178    liftIO $ showPass dflags "Parser"
 179    {-# SCC "Parser" #-} do
 180
 181         -- sometimes we already have the buffer in memory, perhaps
 182         -- because we needed to parse the imports out of it, or get the
 183         -- module name.
 184    buf <- case maybe_src_buf of
 185             Just b  -> return b
 186             Nothing -> liftIO $ hGetStringBuffer src_filename
 187
 188    let loc  = mkSrcLoc (mkFastString src_filename) 1 1
 189
 190    case unP parseModule (mkPState dflags buf loc) of
 191      PFailed span err ->
 192          throwOneError (mkPlainErrMsg span err)
 193
 194      POk pst rdr_module -> do
 195          let ms@(warns,errs) = getMessages pst
 196          logWarnings warns
 197          if errorsFound dflags ms then
 198            liftIO $ throwIO $ mkSrcErr errs
 199           else liftIO $ do
 200            dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_module) ;
 201            dumpIfSet_dyn dflags Opt_D_source_stats "Source Statistics"
 202                                (ppSourceStats False rdr_module) ;
 203            return rdr_module
 204           -- ToDo: free the string buffer later.
 205
 206 -- | Rename and typecheck a module
 207 hscTypecheck :: GhcMonad m =>
 208                 ModSummary -> Located (HsModule RdrName)
 209              -> m TcGblEnv
 210 hscTypecheck mod_summary rdr_module = do
 211       hsc_env <- getSession
 212       r <- {-# SCC "Typecheck-Rename" #-}
 213            ioMsgMaybe $ tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module
 214       return r
 215
 216 -- XXX: should this really be a Maybe X?  Check under which circumstances this
 217 -- can become a Nothing and decide whether this should instead throw an
 218 -- exception/signal an error.
 219 type RenamedStuff =
 220         (Maybe (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
 221                 Maybe LHsDocString))
 222
 223 -- | Rename and typecheck a module, additionally returning the renamed syntax
 224 hscTypecheckRename ::
 225        GhcMonad m =>
 226        ModSummary -> Located (HsModule RdrName)
 227     -> m (TcGblEnv, RenamedStuff)
 228 hscTypecheckRename mod_summary rdr_module = do
 229     hsc_env <- getSession
 230     tc_result
 231           <- {-# SCC "Typecheck-Rename" #-}
 232              ioMsgMaybe $ tcRnModule hsc_env (ms_hsc_src mod_summary) True rdr_module
 233
 234     let -- This 'do' is in the Maybe monad!
 235         rn_info = do { decl <- tcg_rn_decls tc_result
 236                      ; let imports = tcg_rn_imports tc_result
 237                            exports = tcg_rn_exports tc_result
 238                            doc_hdr  = tcg_doc_hdr tc_result
 239                      ; return (decl,imports,exports,doc_hdr) }
 240
 241     return (tc_result, rn_info)
 242
 243 -- | Convert a typechecked module to Core
 244 hscDesugar :: GhcMonad m => ModSummary -> TcGblEnv -> m ModGuts
 245 hscDesugar mod_summary tc_result =
 246   withSession $ \hsc_env ->
 247     ioMsgMaybe $ deSugar hsc_env (ms_location mod_summary) tc_result
 248
 249 -- | Make a 'ModIface' from the results of typechecking.  Used when
 250 -- not optimising, and the interface doesn't need to contain any
 251 -- unfoldings or other cross-module optimisation info.
 252 -- ToDo: the old interface is only needed to get the version numbers,
 253 -- we should use fingerprint versions instead.
 254 makeSimpleIface :: GhcMonad m =>
 255                    Maybe ModIface -> TcGblEnv -> ModDetails
 256                 -> m (ModIface,Bool)
 257 makeSimpleIface maybe_old_iface tc_result details =
 258   withSession $ \hsc_env ->
 259   ioMsgMaybe $ mkIfaceTc hsc_env (fmap mi_iface_hash maybe_old_iface) details tc_result
 260
 261 -- | Make a 'ModDetails' from the results of typechecking.  Used when
 262 -- typechecking only, as opposed to full compilation.
 263 makeSimpleDetails :: GhcMonad m => TcGblEnv -> m ModDetails
 264 makeSimpleDetails tc_result =
 265     withSession $ \hsc_env -> liftIO $ mkBootModDetailsTc hsc_env tc_result
 266 \end{code}
 267
 268 %************************************************************************
 269 %*                                                                      *
 270                 The main compiler pipeline
 271 %*                                                                      *
 272 %************************************************************************
 273
 274                    --------------------------------
 275                         The compilation proper
 276                    --------------------------------
 277
 278
 279 It's the task of the compilation proper to compile Haskell, hs-boot and
 280 core files to either byte-code, hard-code (C, asm, Java, ect) or to
 281 nothing at all (the module is still parsed and type-checked. This
 282 feature is mostly used by IDE's and the likes).
 283 Compilation can happen in either 'one-shot', 'batch', 'nothing',
 284 or 'interactive' mode. 'One-shot' mode targets hard-code, 'batch' mode
 285 targets hard-code, 'nothing' mode targets nothing and 'interactive' mode
 286 targets byte-code.
 287 The modes are kept separate because of their different types and meanings.
 288 In 'one-shot' mode, we're only compiling a single file and can therefore
 289 discard the new ModIface and ModDetails. This is also the reason it only
 290 targets hard-code; compiling to byte-code or nothing doesn't make sense
 291 when we discard the result.
 292 'Batch' mode is like 'one-shot' except that we keep the resulting ModIface
 293 and ModDetails. 'Batch' mode doesn't target byte-code since that require
 294 us to return the newly compiled byte-code.
 295 'Nothing' mode has exactly the same type as 'batch' mode but they're still
 296 kept separate. This is because compiling to nothing is fairly special: We
 297 don't output any interface files, we don't run the simplifier and we don't
 298 generate any code.
 299 'Interactive' mode is similar to 'batch' mode except that we return the
 300 compiled byte-code together with the ModIface and ModDetails.
 301
 302 Trying to compile a hs-boot file to byte-code will result in a run-time
 303 error. This is the only thing that isn't caught by the type-system.
 304
 305 \begin{code}
 306
 307 -- Status of a compilation to hard-code or nothing.
 308 data HscStatus' a
 309     = HscNoRecomp
 310     | HscRecomp
 311        Bool -- Has stub files.  This is a hack. We can't compile C files here
 312             -- since it's done in DriverPipeline. For now we just return True
 313             -- if we want the caller to compile them for us.
 314        a
 315
 316 -- This is a bit ugly.  Since we use a typeclass below and would like to avoid
 317 -- functional dependencies, we have to parameterise the typeclass over the
 318 -- result type.  Therefore we need to artificially distinguish some types.  We
 319 -- do this by adding type tags which will simply be ignored by the caller.
 320 type HscStatus         = HscStatus' ()
 321 type InteractiveStatus = HscStatus' (Maybe (CompiledByteCode, ModBreaks))
 322     -- INVARIANT: result is @Nothing@ <=> input was a boot file
 323
 324 type OneShotResult     = HscStatus
 325 type BatchResult       = (HscStatus, ModIface, ModDetails)
 326 type NothingResult     = (HscStatus, ModIface, ModDetails)
 327 type InteractiveResult = (InteractiveStatus, ModIface, ModDetails)
 328
 329 -- FIXME: The old interface and module index are only using in 'batch' and
 330 --        'interactive' mode. They should be removed from 'oneshot' mode.
 331 type Compiler result =  GhcMonad m =>
 332                         HscEnv
 333                      -> ModSummary
 334                      -> Bool                -- True <=> source unchanged
 335                      -> Maybe ModIface      -- Old interface, if available
 336                      -> Maybe (Int,Int)     -- Just (i,n) <=> module i of n (for msgs)
 337                      -> m result
 338
 339 data HsCompiler a
 340   = HsCompiler {
 341     -- | Called when no recompilation is necessary.
 342     hscNoRecomp :: GhcMonad m =>
 343                    ModIface -> m a,
 344
 345     -- | Called to recompile the module.
 346     hscRecompile :: GhcMonad m =>
 347                     ModSummary -> Maybe Fingerprint -> m a,
 348
 349     hscBackend :: GhcMonad m =>
 350                   TcGblEnv -> ModSummary -> Maybe Fingerprint -> m a,
 351
 352     -- | Code generation for Boot modules.
 353     hscGenBootOutput :: GhcMonad m =>
 354                         TcGblEnv -> ModSummary -> Maybe Fingerprint -> m a,
 355
 356     -- | Code generation for normal modules.
 357     hscGenOutput :: GhcMonad m =>
 358                     ModGuts  -> ModSummary -> Maybe Fingerprint -> m a
 359   }
 360
 361 genericHscCompile :: GhcMonad m =>
 362                      HsCompiler a
 363                   -> (Maybe (Int,Int) -> Bool -> ModSummary -> m ())
 364                   -> HscEnv -> ModSummary -> Bool
 365                   -> Maybe ModIface -> Maybe (Int, Int)
 366                   -> m a
 367 genericHscCompile compiler hscMessage
 368                   hsc_env mod_summary source_unchanged
 369                   mb_old_iface0 mb_mod_index =
 370    withTempSession (\_ -> hsc_env) $ do
 371      (recomp_reqd, mb_checked_iface)
 372          <- {-# SCC "checkOldIface" #-}
 373             liftIO $ checkOldIface hsc_env mod_summary
 374                                    source_unchanged mb_old_iface0
 375      -- save the interface that comes back from checkOldIface.
 376      -- In one-shot mode we don't have the old iface until this
 377      -- point, when checkOldIface reads it from the disk.
 378      let mb_old_hash = fmap mi_iface_hash mb_checked_iface
 379      case mb_checked_iface of
 380        Just iface | not recomp_reqd
 381            -> do hscMessage mb_mod_index False mod_summary
 382                  hscNoRecomp compiler iface
 383        _otherwise
 384            -> do hscMessage mb_mod_index True mod_summary
 385                  hscRecompile compiler mod_summary mb_old_hash
 386
 387 hscCheckRecompBackend :: HsCompiler a -> TcGblEnv -> Compiler a
 388 hscCheckRecompBackend compiler tc_result
 389                    hsc_env mod_summary source_unchanged mb_old_iface _m_of_n =
 390    withTempSession (\_ -> hsc_env) $ do
 391      (recomp_reqd, mb_checked_iface)
 392          <- {-# SCC "checkOldIface" #-}
 393             liftIO $ checkOldIface hsc_env mod_summary
 394                                    source_unchanged mb_old_iface
 395
 396      let mb_old_hash = fmap mi_iface_hash mb_checked_iface
 397      case mb_checked_iface of
 398        Just iface | not recomp_reqd
 399            -> hscNoRecomp compiler iface{ mi_globals = Just (tcg_rdr_env tc_result) }
 400        _otherwise
 401            -> hscBackend compiler tc_result mod_summary mb_old_hash
 402
 403 genericHscRecompile :: GhcMonad m =>
 404                        HsCompiler a
 405                     -> ModSummary -> Maybe Fingerprint
 406                     -> m a
 407 genericHscRecompile compiler mod_summary mb_old_hash
 408   | ExtCoreFile <- ms_hsc_src mod_summary =
 409       panic "GHC does not currently support reading External Core files"
 410   | otherwise = do
 411       tc_result <- hscFileFrontEnd mod_summary
 412       hscBackend compiler tc_result mod_summary mb_old_hash
 413
 414 genericHscBackend :: GhcMonad m =>
 415                      HsCompiler a
 416                   -> TcGblEnv -> ModSummary -> Maybe Fingerprint
 417                   -> m a
 418 genericHscBackend compiler tc_result mod_summary mb_old_hash
 419   | HsBootFile <- ms_hsc_src mod_summary =
 420       hscGenBootOutput compiler tc_result mod_summary mb_old_hash
 421   | otherwise = do
 422       guts <- hscDesugar mod_summary tc_result
 423       hscGenOutput compiler guts mod_summary mb_old_hash
 424
 425 --------------------------------------------------------------
 426 -- Compilers
 427 --------------------------------------------------------------
 428
 429 hscOneShotCompiler :: HsCompiler OneShotResult
 430 hscOneShotCompiler =
 431   HsCompiler {
 432
 433     hscNoRecomp = \_old_iface -> do
 434       withSession (liftIO . dumpIfaceStats)
 435       return HscNoRecomp
 436
 437   , hscRecompile = genericHscRecompile hscOneShotCompiler
 438
 439   , hscBackend = \ tc_result mod_summary mb_old_hash -> do
 440        hsc_env <- getSession
 441        case hscTarget (hsc_dflags hsc_env) of
 442          HscNothing -> return (HscRecomp False ())
 443          _otherw    -> genericHscBackend hscOneShotCompiler
 444                                          tc_result mod_summary mb_old_hash
 445
 446   , hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
 447        (iface, changed, _) <- hscSimpleIface tc_result mb_old_iface
 448        hscWriteIface iface changed mod_summary
 449        return (HscRecomp False ())
 450
 451   , hscGenOutput = \guts0 mod_summary mb_old_iface -> do
 452        guts <- hscSimplify guts0
 453        (iface, changed, _details, cgguts)
 454            <- hscNormalIface guts mb_old_iface
 455        hscWriteIface iface changed mod_summary
 456        hasStub <- hscGenHardCode cgguts mod_summary
 457        return (HscRecomp hasStub ())
 458   }
 459
 460 -- Compile Haskell, boot and extCore in OneShot mode.
 461 hscCompileOneShot :: Compiler OneShotResult
 462 hscCompileOneShot hsc_env mod_summary src_changed mb_old_iface mb_i_of_n = do
 463        -- One-shot mode needs a knot-tying mutable variable for interface
 464        -- files.  See TcRnTypes.TcGblEnv.tcg_type_env_var.
 465       type_env_var <- liftIO $ newIORef emptyNameEnv
 466       let
 467          mod = ms_mod mod_summary
 468          hsc_env' = hsc_env{ hsc_type_env_var = Just (mod, type_env_var) }
 469       ---
 470       genericHscCompile hscOneShotCompiler
 471                         oneShotMsg hsc_env' mod_summary src_changed
 472                         mb_old_iface mb_i_of_n
 473
 474
 475 --------------------------------------------------------------
 476
 477 hscBatchCompiler :: HsCompiler BatchResult
 478 hscBatchCompiler =
 479   HsCompiler {
 480
 481     hscNoRecomp = \iface -> do
 482        details <- genModDetails iface
 483        return (HscNoRecomp, iface, details)
 484
 485   , hscRecompile = genericHscRecompile hscBatchCompiler
 486
 487   , hscBackend = genericHscBackend hscBatchCompiler
 488
 489   , hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
 490        (iface, changed, details)
 491            <- hscSimpleIface tc_result mb_old_iface
 492        hscWriteIface iface changed mod_summary
 493        return (HscRecomp False (), iface, details)
 494
 495   , hscGenOutput = \guts0 mod_summary mb_old_iface -> do
 496        guts <- hscSimplify guts0
 497        (iface, changed, details, cgguts)
 498            <- hscNormalIface guts mb_old_iface
 499        hscWriteIface iface changed mod_summary
 500        hasStub <- hscGenHardCode cgguts mod_summary
 501        return (HscRecomp hasStub (), iface, details)
 502   }
 503
 504 -- Compile Haskell, boot and extCore in batch mode.
 505 hscCompileBatch :: Compiler (HscStatus, ModIface, ModDetails)
 506 hscCompileBatch = genericHscCompile hscBatchCompiler batchMsg
 507
 508 --------------------------------------------------------------
 509
 510 hscInteractiveCompiler :: HsCompiler InteractiveResult
 511 hscInteractiveCompiler =
 512   HsCompiler {
 513     hscNoRecomp = \iface -> do
 514        details <- genModDetails iface
 515        return (HscNoRecomp, iface, details)
 516
 517   , hscRecompile = genericHscRecompile hscInteractiveCompiler
 518
 519   , hscBackend = genericHscBackend hscInteractiveCompiler
 520
 521   , hscGenBootOutput = \tc_result _mod_summary mb_old_iface -> do
 522        (iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
 523        return (HscRecomp False Nothing, iface, details)
 524
 525   , hscGenOutput = \guts0 mod_summary mb_old_iface -> do
 526        guts <- hscSimplify guts0
 527        (iface, _changed, details, cgguts)
 528            <- hscNormalIface guts mb_old_iface
 529        hscInteractive (iface, details, cgguts) mod_summary
 530   }
 531
 532 -- Compile Haskell, extCore to bytecode.
 533 hscCompileInteractive :: Compiler (InteractiveStatus, ModIface, ModDetails)
 534 hscCompileInteractive = genericHscCompile hscInteractiveCompiler batchMsg
 535
 536 --------------------------------------------------------------
 537
 538 hscNothingCompiler :: HsCompiler NothingResult
 539 hscNothingCompiler =
 540   HsCompiler {
 541     hscNoRecomp = \iface -> do
 542        details <- genModDetails iface
 543        return (HscNoRecomp, iface, details)
 544
 545   , hscRecompile = genericHscRecompile hscNothingCompiler
 546
 547   , hscBackend = \tc_result _mod_summary mb_old_iface -> do
 548        (iface, _changed, details) <- hscSimpleIface tc_result mb_old_iface
 549        return (HscRecomp False (), iface, details)
 550
 551   , hscGenBootOutput = \_ _ _ ->
 552         panic "hscCompileNothing: hscGenBootOutput should not be called"
 553
 554   , hscGenOutput = \_ _ _ ->
 555         panic "hscCompileNothing: hscGenOutput should not be called"
 556   }
 557
 558 -- Type-check Haskell and .hs-boot only (no external core)
 559 hscCompileNothing :: Compiler (HscStatus, ModIface, ModDetails)
 560 hscCompileNothing = genericHscCompile hscNothingCompiler batchMsg
 561
 562 --------------------------------------------------------------
 563 -- NoRecomp handlers
 564 --------------------------------------------------------------
 565
 566 genModDetails :: GhcMonad m => ModIface -> m ModDetails
 567 genModDetails old_iface =
 568     withSession $ \hsc_env -> liftIO $ do
 569       new_details <- {-# SCC "tcRnIface" #-}
 570                      initIfaceCheck hsc_env $
 571                      typecheckIface old_iface
 572       dumpIfaceStats hsc_env
 573       return new_details
 574
 575 --------------------------------------------------------------
 576 -- Progress displayers.
 577 --------------------------------------------------------------
 578
 579 oneShotMsg :: GhcMonad m => Maybe (Int,Int) -> Bool -> ModSummary -> m ()
 580 oneShotMsg _mb_mod_index recomp _mod_summary
 581     = do hsc_env <- getSession
 582          liftIO $ do
 583          if recomp
 584             then return ()
 585             else compilationProgressMsg (hsc_dflags hsc_env) $
 586                      "compilation IS NOT required"
 587
 588 batchMsg :: GhcMonad m => Maybe (Int,Int) -> Bool -> ModSummary -> m ()
 589 batchMsg mb_mod_index recomp mod_summary
 590     = do hsc_env <- getSession
 591          let showMsg msg = compilationProgressMsg (hsc_dflags hsc_env) $
 592                            (showModuleIndex mb_mod_index ++
 593                             msg ++ showModMsg (hscTarget (hsc_dflags hsc_env)) recomp mod_summary)
 594          liftIO $ do
 595          if recomp
 596             then showMsg "Compiling "
 597             else if verbosity (hsc_dflags hsc_env) >= 2
 598                     then showMsg "Skipping  "
 599                     else return ()
 600
 601 --------------------------------------------------------------
 602 -- FrontEnds
 603 --------------------------------------------------------------
 604 hscFileFrontEnd :: GhcMonad m => ModSummary -> m TcGblEnv
 605 hscFileFrontEnd mod_summary =
 606     do rdr_module <- hscParse mod_summary
 607        hscTypecheck mod_summary rdr_module
 608
 609 --------------------------------------------------------------
 610 -- Simplifiers
 611 --------------------------------------------------------------
 612
 613 hscSimplify :: GhcMonad m => ModGuts -> m ModGuts
 614 hscSimplify ds_result
 615   = do hsc_env <- getSession
 616        simpl_result <- {-# SCC "Core2Core" #-}
 617                        liftIO $ core2core hsc_env ds_result
 618        return simpl_result
 619
 620 --------------------------------------------------------------
 621 -- Interface generators
 622 --------------------------------------------------------------
 623
 624 hscSimpleIface :: GhcMonad m =>
 625                   TcGblEnv
 626                -> Maybe Fingerprint
 627                -> m (ModIface, Bool, ModDetails)
 628 hscSimpleIface tc_result mb_old_iface
 629   = do hsc_env <- getSession
 630        details <- liftIO $ mkBootModDetailsTc hsc_env tc_result
 631        (new_iface, no_change)
 632            <- {-# SCC "MkFinalIface" #-}
 633               ioMsgMaybe $ mkIfaceTc hsc_env mb_old_iface details tc_result
 634        -- And the answer is ...
 635        liftIO $ dumpIfaceStats hsc_env
 636        return (new_iface, no_change, details)
 637
 638 hscNormalIface :: GhcMonad m =>
 639                   ModGuts
 640                -> Maybe Fingerprint
 641                -> m (ModIface, Bool, ModDetails, CgGuts)
 642 hscNormalIface simpl_result mb_old_iface
 643   = do hsc_env <- getSession
 644
 645        (cg_guts, details) <- {-# SCC "CoreTidy" #-}
 646                              liftIO $ tidyProgram hsc_env simpl_result
 647
 648             -- BUILD THE NEW ModIface and ModDetails
 649             --  and emit external core if necessary
 650             -- This has to happen *after* code gen so that the back-end
 651             -- info has been set.  Not yet clear if it matters waiting
 652             -- until after code output
 653        (new_iface, no_change)
 654            <- {-# SCC "MkFinalIface" #-}
 655               ioMsgMaybe $ mkIface hsc_env mb_old_iface
 656                                    details simpl_result
 657         -- Emit external core
 658        -- This should definitely be here and not after CorePrep,
 659        -- because CorePrep produces unqualified constructor wrapper declarations,
 660        -- so its output isn't valid External Core (without some preprocessing).
 661        liftIO $ emitExternalCore (hsc_dflags hsc_env) cg_guts
 662        liftIO $ dumpIfaceStats hsc_env
 663
 664             -- Return the prepared code.
 665        return (new_iface, no_change, details, cg_guts)
 666
 667 --------------------------------------------------------------
 668 -- BackEnd combinators
 669 --------------------------------------------------------------
 670
 671 hscWriteIface :: GhcMonad m =>
 672                  ModIface -> Bool
 673               -> ModSummary
 674               -> m ()
 675 hscWriteIface iface no_change mod_summary
 676     = do hsc_env <- getSession
 677          let dflags = hsc_dflags hsc_env
 678          liftIO $ do
 679          unless no_change
 680            $ writeIfaceFile dflags (ms_location mod_summary) iface
 681
 682 -- | Compile to hard-code.
 683 hscGenHardCode :: GhcMonad m =>
 684                   CgGuts -> ModSummary
 685                -> m Bool -- ^ @True@ <=> stub.c exists
 686 hscGenHardCode cgguts mod_summary
 687     = withSession $ \hsc_env -> liftIO $ do
 688          let CgGuts{ -- This is the last use of the ModGuts in a compilation.
 689                      -- From now on, we just use the bits we need.
 690                      cg_module   = this_mod,
 691                      cg_binds    = core_binds,
 692                      cg_tycons   = tycons,
 693                      cg_dir_imps = dir_imps,
 694                      cg_foreign  = foreign_stubs,
 695                      cg_dep_pkgs = dependencies,
 696                      cg_hpc_info = hpc_info } = cgguts
 697              dflags = hsc_dflags hsc_env
 698              location = ms_location mod_summary
 699              data_tycons = filter isDataTyCon tycons
 700              -- cg_tycons includes newtypes, for the benefit of External Core,
 701              -- but we don't generate any code for newtypes
 702
 703          -------------------
 704          -- PREPARE FOR CODE GENERATION
 705          -- Do saturation and convert to A-normal form
 706          prepd_binds <- {-# SCC "CorePrep" #-}
 707                         corePrepPgm dflags core_binds data_tycons ;
 708          -----------------  Convert to STG ------------------
 709          (stg_binds, cost_centre_info)
 710              <- {-# SCC "CoreToStg" #-}
 711                 myCoreToStg dflags this_mod prepd_binds
 712
 713          ------------------  Code generation ------------------
 714          cmms <- if dopt Opt_TryNewCodeGen (hsc_dflags hsc_env)
 715                  then do cmms <- tryNewCodeGen hsc_env this_mod data_tycons
 716                                  dir_imps cost_centre_info
 717                                  stg_binds hpc_info
 718                          return cmms
 719                  else {-# SCC "CodeGen" #-}
 720                        codeGen dflags this_mod data_tycons
 721                                dir_imps cost_centre_info
 722                                stg_binds hpc_info
 723
 724          --- Optionally run experimental Cmm transformations ---
 725          -- cmms <- optionallyConvertAndOrCPS hsc_env cmms
 726                  -- unless certain dflags are on, the identity function
 727          ------------------  Code output -----------------------
 728          rawcmms <- cmmToRawCmm cmms
 729          dumpIfSet_dyn dflags Opt_D_dump_cmmz "Raw Cmm" (ppr rawcmms)
 730          (_stub_h_exists, stub_c_exists)
 731              <- codeOutput dflags this_mod location foreign_stubs
 732                 dependencies rawcmms
 733          return stub_c_exists
 734
 735 hscInteractive :: GhcMonad m =>
 736                   (ModIface, ModDetails, CgGuts)
 737                -> ModSummary
 738                -> m (InteractiveStatus, ModIface, ModDetails)
 739 #ifdef GHCI
 740 hscInteractive (iface, details, cgguts) mod_summary
 741     = do hsc_env <- getSession
 742          liftIO $ do
 743          let CgGuts{ -- This is the last use of the ModGuts in a compilation.
 744                      -- From now on, we just use the bits we need.
 745                      cg_module   = this_mod,
 746                      cg_binds    = core_binds,
 747                      cg_tycons   = tycons,
 748                      cg_foreign  = foreign_stubs,
 749                      cg_modBreaks = mod_breaks } = cgguts
 750              dflags = hsc_dflags hsc_env
 751              location = ms_location mod_summary
 752              data_tycons = filter isDataTyCon tycons
 753              -- cg_tycons includes newtypes, for the benefit of External Core,
 754              -- but we don't generate any code for newtypes
 755
 756          -------------------
 757          -- PREPARE FOR CODE GENERATION
 758          -- Do saturation and convert to A-normal form
 759          prepd_binds <- {-# SCC "CorePrep" #-}
 760                         corePrepPgm dflags core_binds data_tycons ;
 761          -----------------  Generate byte code ------------------
 762          comp_bc <- byteCodeGen dflags prepd_binds data_tycons mod_breaks
 763          ------------------ Create f-x-dynamic C-side stuff ---
 764          (_istub_h_exists, istub_c_exists)
 765              <- outputForeignStubs dflags this_mod location foreign_stubs
 766          return (HscRecomp istub_c_exists (Just (comp_bc, mod_breaks))
 767                 , iface, details)
 768 #else
 769 hscInteractive _ _ = panic "GHC not compiled with interpreter"
 770 #endif
 771
 772 ------------------------------
 773
 774 hscCmmFile :: GhcMonad m => HscEnv -> FilePath -> m ()
 775 hscCmmFile hsc_env filename = do
 776     dflags <- return $ hsc_dflags hsc_env
 777     cmm <- ioMsgMaybe $
 778              parseCmmFile dflags filename
 779     cmms <- liftIO $ optionallyConvertAndOrCPS hsc_env [cmm]
 780     rawCmms <- liftIO $ cmmToRawCmm cmms
 781     _ <- liftIO $ codeOutput dflags no_mod no_loc NoStubs [] rawCmms
 782     return ()
 783   where
 784         no_mod = panic "hscCmmFile: no_mod"
 785         no_loc = ModLocation{ ml_hs_file  = Just filename,
 786                               ml_hi_file  = panic "hscCmmFile: no hi file",
 787                               ml_obj_file = panic "hscCmmFile: no obj file" }
 788
 789 -------------------- Stuff for new code gen ---------------------
 790
 791 tryNewCodeGen   :: HscEnv -> Module -> [TyCon] -> [Module]
 792                 -> CollectedCCs
 793                 -> [(StgBinding,[(Id,[Id])])]
 794                 -> HpcInfo
 795                 -> IO [Cmm]
 796 tryNewCodeGen hsc_env this_mod data_tycons imported_mods
 797               cost_centre_info stg_binds hpc_info =
 798   do    { let dflags = hsc_dflags hsc_env
 799         ; prog <- StgCmm.codeGen dflags this_mod data_tycons imported_mods
 800                          cost_centre_info stg_binds hpc_info
 801         ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"
 802                 (pprCmms prog)
 803
 804         ; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) prog
 805                 -- Control flow optimisation
 806
 807         -- We are building a single SRT for the entire module, so
 808         -- we must thread it through all the procedures as we cps-convert them.
 809         ; us <- mkSplitUniqSupply 'S'
 810         ; let topSRT = initUs_ us emptySRT
 811         ; (topSRT, prog) <- foldM (protoCmmCPSZ hsc_env) (topSRT, []) prog
 812                 -- The main CPS conversion
 813
 814         ; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) (srtToData topSRT : prog)
 815                 -- Control flow optimisation, again
 816
 817         ; let prog' = map cmmOfZgraph prog
 818         ; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (ppr prog')
 819         ; return prog' }
 820
 821
 822 optionallyConvertAndOrCPS :: HscEnv -> [Cmm] -> IO [Cmm]
 823 optionallyConvertAndOrCPS hsc_env cmms =
 824     do let dflags = hsc_dflags hsc_env
 825         --------  Optionally convert to and from zipper ------
 826        cmms <- if dopt Opt_ConvertToZipCfgAndBack dflags
 827                then mapM (testCmmConversion hsc_env) cmms
 828                else return cmms
 829          ---------  Optionally convert to CPS (MDA) -----------
 830        cmms <- if not (dopt Opt_ConvertToZipCfgAndBack dflags) &&
 831                   dopt Opt_RunCPS dflags
 832                then cmmCPS dflags cmms
 833                else return cmms
 834        return cmms
 835
 836
 837 testCmmConversion :: HscEnv -> Cmm -> IO Cmm
 838 testCmmConversion hsc_env cmm =
 839     do let dflags = hsc_dflags hsc_env
 840        showPass dflags "CmmToCmm"
 841        dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- pre-conversion" (ppr cmm)
 842        --continuationC <- cmmCPS dflags abstractC >>= cmmToRawCmm
 843        us <- mkSplitUniqSupply 'C'
 844        let cfopts = runTx $ runCmmOpts cmmCfgOptsZ
 845        let cvtm = do g <- cmmToZgraph cmm
 846                      return $ cfopts g
 847        let zgraph = initUs_ us cvtm
 848        us <- mkSplitUniqSupply 'S'
 849        let topSRT = initUs_ us emptySRT
 850        (_, [cps_zgraph]) <- protoCmmCPSZ hsc_env (topSRT, []) zgraph
 851        let chosen_graph = if dopt Opt_RunCPSZ dflags then cps_zgraph else zgraph
 852        dumpIfSet_dyn dflags Opt_D_dump_cmmz "C-- Zipper Graph" (ppr chosen_graph)
 853        showPass dflags "Convert from Z back to Cmm"
 854        let cvt = cmmOfZgraph $ cfopts $ chosen_graph
 855        dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (ppr cvt)
 856        return cvt
 857
 858 myCoreToStg :: DynFlags -> Module -> [CoreBind]
 859             -> IO ( [(StgBinding,[(Id,[Id])])]  -- output program
 860                   , CollectedCCs) -- cost centre info (declared and used)
 861
 862 myCoreToStg dflags this_mod prepd_binds
 863  = do
 864       stg_binds <- {-# SCC "Core2Stg" #-}
 865              coreToStg (thisPackage dflags) prepd_binds
 866
 867       (stg_binds2, cost_centre_info) <- {-# SCC "Stg2Stg" #-}
 868              stg2stg dflags this_mod stg_binds
 869
 870       return (stg_binds2, cost_centre_info)
 871 \end{code}
 872
 873
 874 %************************************************************************
 875 %*                                                                      *
 876 \subsection{Compiling a do-statement}
 877 %*                                                                      *
 878 %************************************************************************
 879
 880 When the UnlinkedBCOExpr is linked you get an HValue of type
 881         IO [HValue]
 882 When you run it you get a list of HValues that should be
 883 the same length as the list of names; add them to the ClosureEnv.
 884
 885 A naked expression returns a singleton Name [it].
 886
 887         What you type                   The IO [HValue] that hscStmt returns
 888         -------------                   ------------------------------------
 889         let pat = expr          ==>     let pat = expr in return [coerce HVal x, coerce HVal y, ...]
 890                                         bindings: [x,y,...]
 891
 892         pat <- expr             ==>     expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
 893                                         bindings: [x,y,...]
 894
 895         expr (of IO type)       ==>     expr >>= \ v -> return [v]
 896           [NB: result not printed]      bindings: [it]
 897
 898
 899         expr (of non-IO type,
 900           result showable)      ==>     let v = expr in print v >> return [v]
 901                                         bindings: [it]
 902
 903         expr (of non-IO type,
 904           result not showable)  ==>     error
 905
 906 \begin{code}
 907 #ifdef GHCI
 908 hscStmt         -- Compile a stmt all the way to an HValue, but don't run it
 909   :: GhcMonad m =>
 910      HscEnv
 911   -> String                     -- The statement
 912   -> m (Maybe ([Id], HValue))
 913      -- ^ 'Nothing' <==> empty statement (or comment only), but no parse error
 914 hscStmt hsc_env stmt = do
 915     maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) stmt
 916     case maybe_stmt of
 917       Nothing -> return Nothing
 918       Just parsed_stmt -> do  -- The real stuff
 919
 920              -- Rename and typecheck it
 921         let icontext = hsc_IC hsc_env
 922         (ids, tc_expr) <- ioMsgMaybe $ tcRnStmt hsc_env icontext parsed_stmt
 923             -- Desugar it
 924         let rdr_env  = ic_rn_gbl_env icontext
 925             type_env = mkTypeEnv (map AnId (ic_tmp_ids icontext))
 926         ds_expr <- ioMsgMaybe $
 927                      deSugarExpr hsc_env iNTERACTIVE rdr_env type_env tc_expr
 928
 929         -- Then desugar, code gen, and link it
 930         let src_span = srcLocSpan interactiveSrcLoc
 931         hval <- liftIO $ compileExpr hsc_env src_span ds_expr
 932
 933         return $ Just (ids, hval)
 934
 935 hscImport :: GhcMonad m => HscEnv -> String -> m (ImportDecl RdrName)
 936 hscImport hsc_env str = do
 937     (L _ (HsModule{hsmodImports=is})) <- hscParseThing parseModule (hsc_dflags hsc_env) str
 938     case is of
 939         [i] -> return (unLoc i)
 940         _ -> throwOneError (mkPlainErrMsg noSrcSpan (ptext (sLit "parse error in import declaration")))
 941
 942 hscTcExpr       -- Typecheck an expression (but don't run it)
 943   :: GhcMonad m =>
 944      HscEnv
 945   -> String                     -- The expression
 946   -> m Type
 947
 948 hscTcExpr hsc_env expr = do
 949     maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) expr
 950     let icontext = hsc_IC hsc_env
 951     case maybe_stmt of
 952       Just (L _ (ExprStmt expr _ _)) -> do
 953           ty <- ioMsgMaybe $ tcRnExpr hsc_env icontext expr
 954           return ty
 955       _ -> do throw $ mkSrcErr $ unitBag $ mkPlainErrMsg
 956                         noSrcSpan
 957                         (text "not an expression:" <+> quotes (text expr))
 958
 959 -- | Find the kind of a type
 960 hscKcType
 961   :: GhcMonad m =>
 962      HscEnv
 963   -> String                     -- ^ The type
 964   -> m Kind
 965
 966 hscKcType hsc_env str = do
 967     ty <- hscParseType (hsc_dflags hsc_env) str
 968     let icontext = hsc_IC hsc_env
 969     ioMsgMaybe $ tcRnType hsc_env icontext ty
 970
 971 #endif
 972 \end{code}
 973
 974 \begin{code}
 975 #ifdef GHCI
 976 hscParseStmt :: GhcMonad m => DynFlags -> String -> m (Maybe (LStmt RdrName))
 977 hscParseStmt = hscParseThing parseStmt
 978
 979 hscParseType :: GhcMonad m => DynFlags -> String -> m (LHsType RdrName)
 980 hscParseType = hscParseThing parseType
 981 #endif
 982
 983 hscParseIdentifier :: GhcMonad m => DynFlags -> String -> m (Located RdrName)
 984 hscParseIdentifier = hscParseThing parseIdentifier
 985
 986 hscParseThing :: (Outputable thing, GhcMonad m)
 987               => Lexer.P thing
 988               -> DynFlags -> String
 989               -> m thing
 990         -- Nothing => Parse error (message already printed)
 991         -- Just x  => success
 992 hscParseThing parser dflags str
 993  = (liftIO $ showPass dflags "Parser") >>
 994       {-# SCC "Parser" #-} do
 995
 996       buf <- liftIO $ stringToStringBuffer str
 997
 998       let loc  = mkSrcLoc (fsLit "<interactive>") 1 1
 999
1000       case unP parser (mkPState dflags buf loc) of
1001
1002         PFailed span err -> do
1003           let msg = mkPlainErrMsg span err
1004           throw (mkSrcErr (unitBag msg))
1005
1006         POk pst thing -> do
1007
1008           let ms@(warns, errs) = getMessages pst
1009           logWarnings warns
1010           when (errorsFound dflags ms) $ -- handle -Werror
1011             throw (mkSrcErr errs)
1012
1013           --ToDo: can't free the string buffer until we've finished this
1014           -- compilation sweep and all the identifiers have gone away.
1015           liftIO $ dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr thing)
1016           return thing
1017 \end{code}
1018
1019 %************************************************************************
1020 %*                                                                      *
1021         Desugar, simplify, convert to bytecode, and link an expression
1022 %*                                                                      *
1023 %************************************************************************
1024
1025 \begin{code}
1026 #ifdef GHCI
1027 compileExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO HValue
1028
1029 compileExpr hsc_env srcspan ds_expr
1030   | rtsIsProfiled
1031   = throwIO (InstallationError "You can't call compileExpr in a profiled compiler")
1032           -- Otherwise you get a seg-fault when you run it
1033
1034   | otherwise
1035   = do  { let { dflags  = hsc_dflags hsc_env ;
1036                 lint_on = dopt Opt_DoCoreLinting dflags }
1037
1038                 -- Simplify it
1039         ; simpl_expr <- simplifyExpr dflags ds_expr
1040
1041                 -- Tidy it (temporary, until coreSat does cloning)
1042         ; let tidy_expr = tidyExpr emptyTidyEnv simpl_expr
1043
1044                 -- Prepare for codegen
1045         ; prepd_expr <- corePrepExpr dflags tidy_expr
1046
1047                 -- Lint if necessary
1048                 -- ToDo: improve SrcLoc
1049         ; if lint_on then
1050                 let ictxt = hsc_IC hsc_env
1051                     tyvars = varSetElems (ic_tyvars ictxt)
1052                 in
1053                 case lintUnfolding noSrcLoc tyvars prepd_expr of
1054                    Just err -> pprPanic "compileExpr" err
1055                    Nothing  -> return ()
1056           else
1057                 return ()
1058
1059                 -- Convert to BCOs
1060         ; bcos <- coreExprToBCOs dflags prepd_expr
1061
1062                 -- link it
1063         ; hval <- linkExpr hsc_env srcspan bcos
1064
1065         ; return hval
1066      }
1067 #endif
1068 \end{code}
1069
1070
1071 %************************************************************************
1072 %*                                                                      *
1073         Statistics on reading interfaces
1074 %*                                                                      *
1075 %************************************************************************
1076
1077 \begin{code}
1078 dumpIfaceStats :: HscEnv -> IO ()
1079 dumpIfaceStats hsc_env
1080   = do  { eps <- readIORef (hsc_EPS hsc_env)
1081         ; dumpIfSet (dump_if_trace || dump_rn_stats)
1082                     "Interface statistics"
1083                     (ifaceStats eps) }
1084   where
1085     dflags = hsc_dflags hsc_env
1086     dump_rn_stats = dopt Opt_D_dump_rn_stats dflags
1087     dump_if_trace = dopt Opt_D_dump_if_trace dflags
1088 \end{code}
1089
1090 %************************************************************************
1091 %*                                                                      *
1092         Progress Messages: Module i of n
1093 %*                                                                      *
1094 %************************************************************************
1095
1096 \begin{code}
1097 showModuleIndex :: Maybe (Int, Int) -> String
1098 showModuleIndex Nothing = ""
1099 showModuleIndex (Just (i,n)) = "[" ++ padded ++ " of " ++ n_str ++ "] "
1100     where
1101         n_str = show n
1102         i_str = show i
1103         padded = replicate (length n_str - length i_str) ' ' ++ i_str
1104 \end{code}