Cheng Shao pushed to branch wip/ghci-no-simpl at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • compiler/GHC/Driver/Main.hs
    ... ... @@ -121,6 +121,7 @@ import GHC.Driver.Errors
    121 121 
     import GHC.Driver.Messager
    122 122 
     import GHC.Driver.Errors.Types
    123 123 
     import GHC.Driver.CodeOutput
    124 
    +import GHC.Driver.Config
    124 125 
     import GHC.Driver.Config.Cmm.Parser (initCmmParserConfig)
    125 126 
     import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyExprOpts )
    126 127 
     import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO )
    ... ... @@ -181,6 +182,7 @@ import GHC.Core.Utils ( exprType )
    181 182 
     import GHC.Core.ConLike
    182 183 
     import GHC.Core.Opt.Pipeline
    183 184 
     import GHC.Core.Opt.Pipeline.Types      ( CoreToDo (..))
    185 
    +import GHC.Core.SimpleOpt
    184 186 
     import GHC.Core.TyCon
    185 187 
     import GHC.Core.InstEnv
    186 188 
     import GHC.Core.FamInstEnv
    ... ... @@ -253,6 +255,7 @@ import GHC.Types.TyThing
    253 255 
     import GHC.Types.Unique.Supply (uniqFromTag)
    254 256 
     import GHC.Types.Unique.Set
    255 257
    258 
    +import GHC.Utils.Exception
    256 259 
     import GHC.Utils.Fingerprint ( Fingerprint )
    257 260 
     import GHC.Utils.Panic
    258 261 
     import GHC.Utils.Error
    ... ... @@ -2448,8 +2451,7 @@ hscParsedStmt hsc_env stmt = runInteractiveHsc hsc_env $ do
    2448 2451 
       -- It's important NOT to have package 'interactive' as thisUnitId
    2449 2452 
       -- for linking, else we try to link 'main' and can't find it.
    2450 2453 
       -- Whereas the linker already knows to ignore 'interactive'
    2451 
    -  let src_span = srcLocSpan interactiveSrcLoc
    2452 
    -  (hval,_,_) <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr
    2454 
    +  (hval,_,_) <- liftIO $ hscCompileCoreExpr hsc_env interactiveSrcSpan ds_expr
    2453 2455
    2454 2456 
       return $ Just (ids, hval, fix_env)
    2455 2457
    ... ... @@ -2512,8 +2514,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
    2512 2514 
           (mkCgInteractiveGuts tidy_cg)
    2513 2515 
           iNTERACTIVELoc
    2514 2516
    2515 
    -    let src_span = srcLocSpan interactiveSrcLoc
    2516 
    -    _ <- liftIO $ loadDecls interp hsc_env src_span linkable
    2517 
    +    _ <- liftIO $ loadDecls interp hsc_env interactiveSrcSpan linkable
    2517 2518
    2518 2519 
         {- Load static pointer table entries -}
    2519 2520 
         liftIO $ hscAddSptEntries hsc_env (cg_spt_entries tidy_cg)
    ... ... @@ -2710,17 +2711,44 @@ hscCompileCoreExpr hsc_env loc expr =
    2710 2711 
           Just h  -> h                   hsc_env loc expr
    2711 2712
    2712 2713 
     hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
    2713 
    -hscCompileCoreExpr' hsc_env srcspan ds_expr = do
    2714 
    -  {- Simplify it -}
    2715 
    -  -- Question: should we call SimpleOpt.simpleOptExpr here instead?
    2716 
    -  -- It is, well, simpler, and does less inlining etc.
    2717 
    -  let dflags = hsc_dflags hsc_env
    2714 
    +hscCompileCoreExpr' hsc_env' srcspan ds_expr = do
    2715 
    +  -- Use modified `dflags` and session that sets -O0 and do less work
    2716 
    +  -- throughout the Core -> ByteCode pipeline, even if current session
    2717 
    +  -- enables `-O1` or above. Unless user manually specified
    2718 
    +  -- `-fno-unoptimized-core-for-interpreter`.
    2719 
    +  let dflags' = hsc_dflags hsc_env'
    2720 
    +      unopt = gopt Opt_UnoptimizedCoreForInterpreter dflags'
    2721 
    +      dflags
    2722 
    +        | unopt = updOptLevel 0 dflags'
    2723 
    +        | otherwise = dflags'
    2724 
    +      hsc_env
    2725 
    +        | unopt = hsc_env' {hsc_dflags = dflags}
    2726 
    +        | otherwise = hsc_env'
    2718 2727 
       let logger = hsc_logger hsc_env
    2719 
    -  let ic = hsc_IC hsc_env
    2720 
    -  let unit_env = hsc_unit_env hsc_env
    2721 
    -  let simplify_expr_opts = initSimplifyExprOpts dflags ic
    2722 2728
    2723 
    -  simpl_expr <- simplifyExpr logger (ue_eps unit_env) simplify_expr_opts ds_expr
    2729 
    +  {- Simplify it -}
    2730 
    +  simpl_expr <-
    2731 
    +    if unopt
    2732 
    +      then
    2733 
    +        evaluate $
    2734 
    +          -- When generating bytecode for ghci via `hscParsedStmt`, we
    2735 
    +          -- still need to enable inlining! For `let foo = Foo ...`, the
    2736 
    +          -- ghci debugger expects `:print foo` to show `foo = <Foo> ...`
    2737 
    +          -- without forcing `foo` first, without inlining `foo`
    2738 
    +          -- would remain a top-level thunk instead of a datacon
    2739 
    +          -- closure. We can skip inlining for TH splices though.
    2740 
    +          ( if srcspan == interactiveSrcSpan
    2741 
    +              then simpleOptExpr
    2742 
    +              else simpleOptExprNoInline
    2743 
    +          )
    2744 
    +            (initSimpleOpts dflags)
    2745 
    +            ds_expr
    2746 
    +      else
    2747 
    +        simplifyExpr
    2748 
    +          logger
    2749 
    +          (ue_eps $ hsc_unit_env hsc_env)
    2750 
    +          (initSimplifyExprOpts dflags $ hsc_IC hsc_env)
    2751 
    +          ds_expr
    2724 2752
    2725 2753 
       -- Create a unique temporary binding
    2726 2754 
       --

  • compiler/GHC/Driver/Session/Inspect.hs
    ... ... @@ -133,7 +133,7 @@ availsToGlobalRdrEnv hsc_env mod avails
    133 133 
         imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
    134 134 
         decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
    135 135 
                              is_qual = False, is_isboot = NotBoot, is_pkg_qual = NoPkgQual,
    136 
    -                         is_dloc = srcLocSpan interactiveSrcLoc,
    136 
    +                         is_dloc = interactiveSrcSpan,
    137 137 
                              is_level = NormalLevel }
    138 138
    139 139 
     getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
    ... ... @@ -198,4 +198,3 @@ modInfoSafe = minf_safe
    198 198
    199 199 
     modInfoModBreaks :: ModuleInfo -> Maybe InternalModBreaks
    200 200 
     modInfoModBreaks = minf_modBreaks
    201 
    -

  • compiler/GHC/Types/SrcLoc.hs
    ... ... @@ -19,8 +19,6 @@ module GHC.Types.SrcLoc (
    19 19 
             leftmostColumn,
    20 20
    21 21 
             noSrcLoc,               -- "I'm sorry, I haven't a clue"
    22 
    -        generatedSrcLoc,        -- Code generated within the compiler
    23 
    -        interactiveSrcLoc,      -- Code from an interactive session
    24 22
    25 23 
             advanceSrcLoc,
    26 24 
             advanceBufPos,
    ... ... @@ -255,10 +253,8 @@ getBufPos (RealSrcLoc _ mbpos) = mbpos
    255 253 
     getBufPos (UnhelpfulLoc _) = Strict.Nothing
    256 254
    257 255 
     -- | Built-in "bad" 'SrcLoc' values for particular locations
    258 
    -noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
    256 
    +noSrcLoc :: SrcLoc
    259 257 
     noSrcLoc          = UnhelpfulLoc (fsLit "<no location info>")
    260 
    -generatedSrcLoc   = UnhelpfulLoc (fsLit "<compiler-generated code>")
    261 
    -interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive>")
    262 258
    263 259 
     -- | Creates a "bad" 'SrcLoc' that has no detailed information about its location
    264 260 
     mkGeneralSrcLoc :: FastString -> SrcLoc

  • hadrian/src/Rules/Gmp.hs
    ... ... @@ -12,7 +12,6 @@ import Utilities
    12 12 
     import Hadrian.BuildPath
    13 13 
     import Hadrian.Expression
    14 14 
     import Settings.Builders.Common (cArgs, getStagedCCFlags)
    15 
    -import GHC.Platform.ArchOS
    16 15
    17 16 
     -- | Build in-tree GMP library objects (if GmpInTree flag is set) and return
    18 17 
     -- their paths.
    ... ... @@ -128,7 +127,10 @@ gmpRules = do
    128 127 
                     mconcat
    129 128 
                         [ cArgs
    130 129 
                         , getStagedCCFlags
    131 
    -                    , anyTargetArch [ArchWasm32] ? arg "-fvisibility=default"
    130 
    +                    -- gmp symbols are only used by bignum logic in
    131 
    +                    -- ghc-internal and shouldn't be exported by the
    132 
    +                    -- ghc-internal shared library.
    133 
    +                    , arg "-fvisibility=hidden"
    132 134 
                         ]
    133 135 
                 env <- sequence
    134 136 
                          [ builderEnvironment "CC" $ Cc CompileC (stage ctx)

  • testsuite/tests/interface-stability/ghc-prim-exports.stdout
    ... ... @@ -3481,6 +3481,7 @@ module GHC.PrimopWrappers where
    3481 3481 
       remWord8# :: GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8#
    3482 3482 
       resizeMutableByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> (# GHC.Internal.Prim.State# s, GHC.Internal.Prim.MutableByteArray# s #)
    3483 3483 
       retry# :: forall a_levpoly. GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, a_levpoly #)
    3484 
    +  seq :: forall a b_reppoly. a -> b_reppoly -> b_reppoly
    3484 3485 
       setAddrRange# :: GHC.Internal.Prim.Addr# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    3485 3486 
       setByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> GHC.Internal.Prim.State# s
    3486 3487 
       setOtherThreadAllocationCounter# :: GHC.Internal.Prim.Int64# -> GHC.Internal.Prim.ThreadId# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld

  • testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
    ... ... @@ -3484,6 +3484,7 @@ module GHC.PrimopWrappers where
    3484 3484 
       remWord8# :: GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8# -> GHC.Internal.Prim.Word8#
    3485 3485 
       resizeMutableByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> (# GHC.Internal.Prim.State# s, GHC.Internal.Prim.MutableByteArray# s #)
    3486 3486 
       retry# :: forall a_levpoly. GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld, a_levpoly #)
    3487 
    +  seq :: forall a b_reppoly. a -> b_reppoly -> b_reppoly
    3487 3488 
       setAddrRange# :: GHC.Internal.Prim.Addr# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    3488 3489 
       setByteArray# :: forall s. GHC.Internal.Prim.MutableByteArray# s -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.State# s -> GHC.Internal.Prim.State# s
    3489 3490 
       setOtherThreadAllocationCounter# :: GHC.Internal.Prim.Int64# -> GHC.Internal.Prim.ThreadId# -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld -> GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld

  • utils/genprimopcode/Main.hs
    ... ... @@ -510,7 +510,7 @@ gen_wrappers (Info _ entries)
    510 510 
             want_wrapper :: Entry -> Bool
    511 511 
             want_wrapper entry =
    512 512 
               and
    513 
    -            [ is_primop entry
    513 
    +            [ (is_primop entry || is_seq_pseudoop entry)
    514 514 
                 , not $ name entry `elem` magical_primops
    515 515 
                 , not $ is_vector entry
    516 516 
                     -- We currently don't generate wrappers for vector primops.
    ... ... @@ -520,6 +520,12 @@ gen_wrappers (Info _ entries)
    520 520 
                     -- suppose this choice can be revisited?
    521 521 
                 ]
    522 522
    523 
    +        -- We also want a wrapper for the `seq` pseudoop, since GHCi
    524 
    +        -- expects to find a value binding in PrimopWrappers.
    525 
    +        is_seq_pseudoop :: Entry -> Bool
    526 
    +        is_seq_pseudoop (PseudoOpSpec { name = n }) = n == "seq"
    527 
    +        is_seq_pseudoop _ = False
    528 
    +
    523 529 
             magical_primops :: [String]
    524 530 
             magical_primops =
    525 531 
               [ "tagToEnum#"

  • utils/genprimopcode/hie.yaml
    1 
    +cradle:
    2 
    +  cabal:

  • utils/jsffi/dyld.mjs
    ... ... @@ -291,7 +291,7 @@ const isNode = Boolean(globalThis?.process?.versions?.node);
    291 291 
     // factor out browser-only/node-only logic into different modules. For
    292 292 
     // now, just make these global let bindings optionally initialized if
    293 293 
     // isNode and be careful to not use them in browser-only logic.
    294 
    -let fs, http, path, require, stream, util, wasi, ws, zlib;
    294 
    +let fs, http, path, require, stream, wasi, ws;
    295 295
    296 296 
     if (isNode) {
    297 297 
       require = (await import("node:module")).createRequire(import.meta.url);
    ... ... @@ -300,9 +300,7 @@ if (isNode) {
    300 300 
       http = require("http");
    301 301 
       path = require("path");
    302 302 
       stream = require("stream");
    303 
    -  util = require("util");
    304 303 
       wasi = require("wasi");
    305 
    -  zlib = require("zlib");
    306 304
    307 305 
       // Optional npm dependencies loaded via NODE_PATH
    308 306 
       try {
    ... ... @@ -561,30 +559,8 @@ args.rpc.opened.then(() => main(args));
    561 559 
               }[path.extname(p)] || "application/octet-stream"
    562 560 
             );
    563 561
    564 
    -        const buf = Buffer.from(await fs.promises.readFile(p));
    565 
    -        const etag = `sha512-${Buffer.from(
    566 
    -          await crypto.subtle.digest("SHA-512", buf)
    567 
    -        ).toString("base64")}`;
    568 
    -
    569 
    -        res.setHeader("ETag", etag);
    570 
    -
    571 
    -        if (req.headers["if-none-match"] === etag) {
    572 
    -          res.writeHead(304);
    573 
    -          res.end();
    574 
    -          return;
    575 
    -        }
    576 
    -
    577 
    -        res.setHeader("Content-Encoding", "br");
    578 
    -
    579 562 
             res.writeHead(200);
    580 
    -        res.end(
    581 
    -          await util.promisify(zlib.brotliCompress)(buf, {
    582 
    -            params: {
    583 
    -              [zlib.constants.BROTLI_PARAM_QUALITY]:
    584 
    -                zlib.constants.BROTLI_MIN_QUALITY,
    585 
    -            },
    586 
    -          })
    587 
    -        );
    563 
    +        fs.createReadStream(p).pipe(res);
    588 564 
             return;
    589 565 
           }
    590 566

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help