Hannes Siebenhandl pushed to branch wip/fendor/ghc-ghci-mhu-27640 at Glasgow Haskell Compiler / GHC

Commits:

21 changed files:

Changes:

  • changelog.d/T27202
    1 1 
     section: ghci
    2 2 
     synopsis: Fix regression to honour module targets in nested directories into GHCi after startup.
    3 
    -issues: #27202
    4 
    -mrs: !15980
    3 
    +issues: #27202 #27640
    4 
    +mrs: !15980 !16591
    5 5
    6 6 
     description: {
    7 7 
         Fix a regression that made it impossible to import modules using `:load <Mod>` and `:add <Mod>` after GHCi startup.

  • ghc/GHCi/UI.hs
    ... ... @@ -763,7 +763,7 @@ installInteractiveHomeUnits dflags = do
    763 763 
         -- However, in the case of multiple home units, initialised via @ghci -unit ... -unit ...@, there
    764 764 
         -- are not @-package-db@ arguments in the base 'DynFlags'...
    765 765 
         -- To fix this, we look at the home units and merge their package dbs stacks.
    766 
    -    -- We assume, that many package db stacks look almost identical, and only differ in view elements.
    766 
    +    -- We assume, that many package db stacks look almost identical, and only differ in few unit databases.
    767 767 
         -- Thus, we try to extract a common package db stack (i.e., longest common prefix), and then concat
    768 768 
         -- the rest of the package db stacks. At last, we add the two result package db stacks.
    769 769 
         -- This should work reliably with cabal and stack, but it is hacky.
    ... ... @@ -864,8 +864,14 @@ installInteractiveHomeUnits dflags = do
    864 864 
           pure (HUG.mkHomeUnitEnv unit_state dflags hpt (Just home_unit))
    865 865
    866 866 
         concatPackageDbStacksUsingLongestCommonPrefix :: [[PackageDBFlag]] -> [PackageDBFlag]
    867 
    -    concatPackageDbStacksUsingLongestCommonPrefix stacks =
    867 
    +    concatPackageDbStacksUsingLongestCommonPrefix stacks' =
    868 868 
           let
    869 
    +        -- Package DB stacks are accumulated from the cli right to left.
    870 
    +        -- E.g., @-clear-package-db -global-package-db@ is stored as
    871 
    +        -- @[PackageDB GlobalPkgDb, ClearPackageDBs]@.
    872 
    +        -- Hence, we reverse the stacks, before computing the longest common prefix,
    873 
    +        -- otherwise the prefix won't match at all.
    874 
    +        stacks = map List.reverse stacks'
    869 875 
             -- O (m * n)
    870 876 
             -- m ... Number of PackageDBFlag stacks
    871 877 
             -- n ... Size of the stacks
    ... ... @@ -873,8 +879,21 @@ installInteractiveHomeUnits dflags = do
    873 879 
               map List.head . List.takeWhile ((List.all . (==) . List.head) <*> List.tail) . List.transpose
    874 880 
             prefix =
    875 881 
               longestCommonPrefix stacks
    882 
    +
    883 
    +        -- We reverse each individual stack segment to maintain the relative order within in a package
    884 
    +        -- db stack.
    885 
    +        -- There should be no 'ClearPackageDBs' in here, otherwise we are going to overwrite
    886 
    +        -- the longest common prefix stacks.
    887 
    +        --
    888 
    +        -- @nubOrd@ can silently change precedence of package db stack merging.
    889 
    +        -- This is not trivially avoidable right now, since multiple home units could simply
    890 
    +        -- have package db stacks that cannot be unified.
    891 
    +        unmergeableStack =
    892 
    +          nubOrd (concatMap (List.reverse . List.drop (length prefix)) stacks)
    876 893 
           in
    877 
    -        prefix ++ nubOrd (concatMap (List.drop (length prefix)) stacks)
    894 
    +        -- We reverse the final common package db stack again to match the expectation of 'packageDBFlags' that they are
    895 
    +        -- stord in reverse order.
    896 
    +        unmergeableStack ++ reverse prefix
    878 897
    879 898 
     reportError :: GhciMonad m => GhciCommandMessage -> m ()
    880 899 
     reportError err = do

  • libraries/base/base.cabal.in
    ... ... @@ -117,6 +117,7 @@ Library
    117 117 
             , Data.Monoid
    118 118 
             , Data.Ord
    119 119 
             , Data.Proxy
    120 
    +        , Data.RealFloat
    120 121 
             , Data.STRef
    121 122 
             , Data.STRef.Strict
    122 123 
             , Data.String

  • libraries/base/changelog.md
    ... ... @@ -9,6 +9,8 @@
    9 9 
       * Introduce `Data.Double` and `Data.Float` modules. ([CLC proposal #378](https://github.com/haskell/core-libraries-committee/issues/378))
    10 10 
       * Change `Generically a`'s `Monoid` definition to require a `Semigroup` constraint, and define its `mconcat` using `(<>)` from that constraint. ([CLC proposal #413](https://github.com/haskell/core-libraries-committee/issues/413))
    11 11 
       * Add `withEmptyCallStack` to `GHC.Stack`. ([CLC proposal #428](https://github.com/haskell/core-libraries-committee/issues/428))
    12 
    +  * Add new `Data.RealFloat` module re-exporting `RealFloat` from `GHC.Float` ([CLC proposal #394](https://github.com/haskell/core-libraries-committee/issues/394))
    13 
    +  * Add `Infinity`, `NegInfinity`, and `NaN` pattern synonyms to `Data.RealFloat` ([CLC proposal #394](https://github.com/haskell/core-libraries-committee/issues/394))
    12 14
    13 15 
     ## 4.23.0.0 *TBA*
    14 16 
       * Add `System.IO.hGetNewlineMode`. ([CLC proposal #370](https://github.com/haskell/core-libraries-committee/issues/370))

  • libraries/base/src/Data/RealFloat.hs
    1 
    +{-# LANGUAGE CPP #-}
    2 
    +{-# LANGUAGE PatternSynonyms #-}
    3 
    +{-# LANGUAGE Safe #-}
    4 
    +{-# LANGUAGE ViewPatterns #-}
    5 
    +
    6 
    +-- |
    7 
    +--
    8 
    +-- Module      :  Data.RealFloat
    9 
    +-- Copyright   :  (c) The University of Glasgow 2026
    10 
    +-- License     :  BSD-style (see the file libraries/base/LICENSE)
    11 
    +--
    12 
    +-- Maintainer  :  libraries@haskell.org
    13 
    +-- Stability   :  stable
    14 
    +-- Portability :  portable
    15 
    +--
    16 
    +
    17 
    +module Data.RealFloat (
    18 
    +  RealFloat (..),
    19 
    +
    20 
    +  -- * Infinity + NaN
    21 
    +  pattern Infinity,
    22 
    +  pattern NegInfinity,
    23 
    +  pattern NaN,
    24 
    +) where
    25 
    +
    26 
    +import Data.Bool (Bool (..), (&&))
    27 
    +import GHC.Internal.Data.Ord ((<), (>))
    28 
    +import GHC.Internal.Float (RealFloat (..))
    29 
    +import GHC.Internal.Real ((/))
    30 
    +#if __GLASGOW_HASKELL__ >= 1001
    31 
    +import qualified GHC.Essentials as Rebindable
    32 
    +#endif
    33 
    +
    34 
    +pattern Infinity :: (RealFloat a) => a
    35 
    +pattern Infinity <- ((\x -> isInfinite x && x > 0) -> True) where Infinity = 1/0
    36 
    +
    37 
    +-- | Negative infinity
    38 
    +--
    39 
    +-- Provided for convenience. Could also use the following instead:
    40 
    +--   * Pattern matching: @(negate -> Infinity)@
    41 
    +--   * Expressions: @-Infinity@
    42 
    +pattern NegInfinity :: (RealFloat a) => a
    43 
    +pattern NegInfinity <- ((\x -> isInfinite x && x < 0) -> True) where NegInfinity = -1/0
    44 
    +
    45 
    +-- | A pattern synonym for NaN values.
    46 
    +--
    47 
    +-- Note: Per IEEE 754, NaN is never equal to itself, thus these two snippets
    48 
    +-- have different behavior:
    49 
    +--
    50 
    +-- @
    51 
    +-- -- foo1 NaN == "a"
    52 
    +-- foo1 NaN = "a"
    53 
    +-- foo1 _ = "b"
    54 
    +--
    55 
    +-- -- foo2 NaN == "b"
    56 
    +-- foo2 x = if x == NaN then "a" else "b"
    57 
    +-- @
    58 
    +pattern NaN :: (RealFloat a) => a
    59 
    +pattern NaN <- (isNaN -> True) where NaN = 0/0

  • rts/linker/elf_reloc_riscv64.c
    ... ... @@ -679,7 +679,7 @@ void flushInstructionCacheRISCV64(ObjectCode *oc) {
    679 679
    680 680 
       /* The main object code */
    681 681 
       void *codeBegin = oc->image + oc->misalignment;
    682 
    -  __builtin___clear_cache(codeBegin, (void*) ((uint64_t*) codeBegin + oc->fileSize));
    682 
    +  __builtin___clear_cache(codeBegin, (void*) ((uint8_t*) codeBegin + oc->fileSize));
    683 683
    684 684 
       /* Jump Islands */
    685 685 
       __builtin___clear_cache((void *)oc->symbol_extras,

  • testsuite/tests/ghci/prog-mhu007/Makefile
    1 
    +TOP=../../..
    2 
    +include $(TOP)/mk/boilerplate.mk
    3 
    +include $(TOP)/mk/test.mk
    4 
    +
    5 
    +PKGCONF_FOO=local-foo.package.conf
    6 
    +PKGCONF_BAR=local-bar.package.conf
    7 
    +LOCAL_GHC_PKG_FOO = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_FOO)
    8 
    +LOCAL_GHC_PKG_BAR = '$(GHC_PKG)' --no-user-package-db -f $(PKGCONF_BAR)
    9 
    +
    10 
    +# Finds both packages in different unit databases
    11 
    +.PHONY: prog-mhu007
    12 
    +prog-mhu007:
    13 
    +	cd testpkg-foo && \
    14 
    +		'$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
    15 
    +			-v0 -fno-code -fwrite-interface -hidir dist-testpkg-foo-0.1.0.0 -this-unit-id testpkg-foo-0.1.0.0-XXX  \
    16 
    +			-i. Foo
    17 
    +	cd testpkg-bar && \
    18 
    +		'$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -hisuf=$(ghciWayExt) $(ghciWayFlags) \
    19 
    +			-v0 -fno-code -fwrite-interface -hidir dist-testpkg-bar-0.1.0.0 -this-unit-id testpkg-bar-0.1.0.0-XXX  \
    20 
    +			-i. Bar
    21 
    +
    22 
    +	$(LOCAL_GHC_PKG_FOO) init $(PKGCONF_FOO) 2>/dev/null
    23 
    +	$(LOCAL_GHC_PKG_FOO) register --force testpkg-foo/testpkg-foo.pkg 2>/dev/null
    24 
    +	$(LOCAL_GHC_PKG_FOO) hide testpkg-foo
    25 
    +	$(LOCAL_GHC_PKG_FOO) list
    26 
    +
    27 
    +	$(LOCAL_GHC_PKG_BAR) init $(PKGCONF_BAR) 2>/dev/null
    28 
    +	$(LOCAL_GHC_PKG_BAR) register --force testpkg-bar/testpkg-bar.pkg 2>/dev/null
    29 
    +	$(LOCAL_GHC_PKG_BAR) hide testpkg-bar
    30 
    +	$(LOCAL_GHC_PKG_BAR) list
    31 
    +
    32 
    +	'$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(WAY_FLAGS) $(ghciWayFlags) \
    33 
    +		-no-user-package-db -fno-code -unit @unitA -unit @unitB < prog-mhu007.script

  • testsuite/tests/ghci/prog-mhu007/a/A.hs
    1 
    +module A where
    2 
    +
    3 
    +import Bar

  • testsuite/tests/ghci/prog-mhu007/all.T
    1 
    +
    2 
    +proj_files = extra_files(['a/', 'b/', 'unitA', 'unitB', 'testpkg-bar/', 'testpkg-foo/'])
    3 
    +
    4 
    +test('prog-mhu007',
    5 
    +     [proj_files,
    6 
    +     cmd_prefix('ghciWayFlags=' + config.ghci_way_flags),
    7 
    +     req_interp],
    8 
    +     makefile_test, ['prog-mhu007'])

  • testsuite/tests/ghci/prog-mhu007/b/B.hs
    1 
    +module B where
    2 
    +
    3 
    +import Foo

  • testsuite/tests/ghci/prog-mhu007/prog-mhu007.script
    1 
    +:m + A B
    2 
    +"Loaded A and B"
    3 
    +import Foo
    4 
    +import Bar
    5 
    +"Loaded dependencies Foo and Bar"

  • testsuite/tests/ghci/prog-mhu007/prog-mhu007.stdout
    1 
    +Reading package info from "testpkg-foo/testpkg-foo.pkg" ... done.
    2 
    +local-foo.package.conf
    3 
    +    (testpkg-foo-0.1.0.0)
    4 
    +
    5 
    +Reading package info from "testpkg-bar/testpkg-bar.pkg" ... done.
    6 
    +local-bar.package.conf
    7 
    +    (testpkg-bar-0.1.0.0)
    8 
    +
    9 
    +"Loaded A and B"
    10 
    +"Loaded dependencies Foo and Bar"

  • testsuite/tests/ghci/prog-mhu007/testpkg-bar/Bar.hs
    1 
    +module Bar where

  • testsuite/tests/ghci/prog-mhu007/testpkg-bar/testpkg-bar.pkg
    1 
    +name: testpkg-bar
    2 
    +version: 0.1.0.0
    3 
    +id: testpkg-bar-0.1.0.0-XXX
    4 
    +key: testpkg-bar-0.1.0.0-XXX
    5 
    +exposed: True
    6 
    +exposed-modules: Bar
    7 
    +hidden-modules:
    8 
    +import-dirs: ${pkgroot}/testpkg-bar/dist-testpkg-bar-0.1.0.0
    9 
    +library-dirs:
    10 
    +include-dirs:
    11 
    +hs-libraries:

  • testsuite/tests/ghci/prog-mhu007/testpkg-foo/Foo.hs
    1 
    +module Foo where

  • testsuite/tests/ghci/prog-mhu007/testpkg-foo/testpkg-foo.pkg
    1 
    +name: testpkg-foo
    2 
    +version: 0.1.0.0
    3 
    +id: testpkg-foo-0.1.0.0-XXX
    4 
    +key: testpkg-foo-0.1.0.0-XXX
    5 
    +exposed: True
    6 
    +exposed-modules: Foo
    7 
    +hidden-modules:
    8 
    +import-dirs: ${pkgroot}/testpkg-foo/dist-testpkg-foo-0.1.0.0
    9 
    +library-dirs:
    10 
    +include-dirs:
    11 
    +hs-libraries:

  • testsuite/tests/ghci/prog-mhu007/unitA
    1 
    +-i
    2 
    +-ia/
    3 
    +A
    4 
    +-this-unit-id a-0.0.0
    5 
    +-this-package-name a
    6 
    +-clear-package-db
    7 
    +-global-package-db
    8 
    +-no-user-package-db
    9 
    +-package-db local-bar.package.conf
    10 
    +-package base
    11 
    +-package-id testpkg-bar-0.1.0.0-XXX

  • testsuite/tests/ghci/prog-mhu007/unitB
    1 
    +-i
    2 
    +-ib/
    3 
    +B
    4 
    +-this-unit-id b-0.0.0
    5 
    +-this-package-name b
    6 
    +-clear-package-db
    7 
    +-global-package-db
    8 
    +-no-user-package-db
    9 
    +-package-db local-foo.package.conf
    10 
    +-package base
    11 
    +-package-id testpkg-foo-0.1.0.0-XXX

  • testsuite/tests/interface-stability/base-exports.stdout
    No preview for this file type
  • testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
    No preview for this file type
  • testsuite/tests/interface-stability/base-exports.stdout-mingw32
    No preview for this file type

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/compare/b304c203d3f30dc9c8c9fa381a126856c56b82c5...987ac4fcd353743fbd9e415e5bd008fe11e89eb0 at 1787756774