[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: rts: remove copy-paste error from `cabal.rts.in`
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Sep 21 09:48:19 UTC 2022
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
854224ed by Nicolas Trangez at 2022-09-20T20:14:29-04:00
rts: remove copy-paste error from `cabal.rts.in`
This was, likely accidentally, introduced in 4bf542bf1c.
See: 4bf542bf1cdf2fa468457fc0af21333478293476
- - - - -
c8ae3add by Matthew Pickering at 2022-09-20T20:15:04-04:00
hadrian: Add extra_dependencies edges for all different ways
The hack to add extra dependencies needed by DeriveLift extension missed
the cases for profiles and dynamic ways. For the profiled way this leads
to errors like:
```
GHC error in desugarer lookup in Data.IntSet.Internal:
Failed to load interface for ‘Language.Haskell.TH.Lib.Internal’
Perhaps you haven't installed the profiling libraries for package ‘template-haskell’?
Use -v (or `:set -v` in ghci) to see a list of the files searched for.
ghc: panic! (the 'impossible' happened)
GHC version 9.5.20220916:
initDs
```
Therefore the fix is to add these extra edges in.
Fixes #22197
- - - - -
a971657d by Mon Aaraj at 2022-09-21T06:41:24+03:00
users-guide: fix incorrect ghcappdata folder for unix and windows
- - - - -
fe5ab480 by sheaf at 2022-09-21T05:48:00-04:00
Don't use isUnliftedType in isTagged
The function GHC.Stg.InferTags.Rewrite.isTagged can be given
the Id of a join point, which might be representation polymorphic.
This would cause the call to isUnliftedType to crash. It's better
to use typeLevity_maybe instead.
Fixes #22212
- - - - -
6 changed files:
- compiler/GHC/Stg/InferTags/Rewrite.hs
- docs/users_guide/ghci.rst
- hadrian/src/Rules/Dependencies.hs
- rts/rts.cabal.in
- + testsuite/tests/simplStg/should_compile/T22212.hs
- testsuite/tests/simplStg/should_compile/all.T
Changes:
=====================================
compiler/GHC/Stg/InferTags/Rewrite.hs
=====================================
@@ -21,15 +21,19 @@ where
import GHC.Prelude
import GHC.Builtin.PrimOps ( PrimOp(..) )
+import GHC.Types.Basic ( CbvMark (..), isMarkedCbv
+ , TopLevelFlag(..), isTopLevel
+ , Levity(..) )
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Unique.Supply
import GHC.Types.Unique.FM
import GHC.Types.RepType
-import GHC.Unit.Types (Module)
+import GHC.Types.Var.Set
+import GHC.Unit.Types ( Module )
import GHC.Core.DataCon
-import GHC.Core (AltCon(..) )
+import GHC.Core ( AltCon(..) )
import GHC.Core.Type
import GHC.StgToCmm.Types
@@ -47,8 +51,7 @@ import GHC.Utils.Misc
import GHC.Stg.InferTags.Types
import Control.Monad
-import GHC.Types.Basic (CbvMark (NotMarkedCbv, MarkedCbv), isMarkedCbv, TopLevelFlag(..), isTopLevel)
-import GHC.Types.Var.Set
+
-- import GHC.Utils.Trace
-- import GHC.Driver.Ppr
@@ -217,7 +220,9 @@ isTagged v = do
this_mod <- getMod
case nameIsLocalOrFrom this_mod (idName v) of
True
- | isUnliftedType (idType v)
+ | Just Unlifted <- typeLevity_maybe (idType v)
+ -- NB: v might be the Id of a representation-polymorphic join point,
+ -- so we shouldn't use isUnliftedType here. See T22212.
-> return True
| otherwise -> do -- Local binding
!s <- getMap
=====================================
docs/users_guide/ghci.rst
=====================================
@@ -3295,13 +3295,12 @@ reads and executes commands from the following files, in this order, if
they exist:
1. :file:`{ghcappdata}/ghci.conf`, where ⟨ghcappdata⟩ depends on
- your system, but is usually something like :file:`$HOME/.ghc` on
- Unix or :file:`C:/Documents and Settings/user/Application
- Data/ghc` on Windows.
+ your system, but is usually something like :file:`$HOME/.ghc` or
+ :file:`$XDG_CONFIG_HOME/ghc` on Unix or
+ :file:`C:\\Users\\{username}\\AppData\\Roaming\\ghc` on
+ Windows.
-2. :file:`$XDG_CONFIG_HOME/.ghci`
-
-3. :file:`./.ghci`
+2. :file:`./.ghci`
The :file:`ghci.conf` file is most useful for turning on favourite options
(e.g. ``:set +s``), and defining useful macros.
=====================================
hadrian/src/Rules/Dependencies.hs
=====================================
@@ -14,6 +14,7 @@ import Target
import Utilities
import Packages
import qualified Data.Map as M
+import qualified Data.Set as S
import qualified Text.Parsec as Parsec
@@ -22,7 +23,7 @@ import qualified Text.Parsec as Parsec
-- until it does we need to add this dependency ourselves.
extra_dependencies :: M.Map Package (Stage -> Action [(FilePath, FilePath)])
extra_dependencies =
- M.fromList [(containers, fmap sequence (sequence
+ M.fromList [(containers, fmap (fmap concat . sequence) (sequence
[dep (containers, "Data.IntSet.Internal") th_internal
,dep (containers, "Data.Set.Internal") th_internal
,dep (containers, "Data.Sequence.Internal") th_internal
@@ -32,9 +33,12 @@ extra_dependencies =
where
th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal")
- dep (p1, m1) (p2, m2) s = (,) <$> path s p1 m1 <*> path s p2 m2
- path stage p m =
- let context = Context stage p vanilla Inplace
+ dep (p1, m1) (p2, m2) s = do
+ let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set")
+ ways <- interpretInContext context getLibraryWays
+ mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways)
+ path stage way p m =
+ let context = Context stage p way Inplace
in objectPath context . moduleSource $ m
formatExtra :: (FilePath, FilePath) -> String
=====================================
rts/rts.cabal.in
=====================================
@@ -419,9 +419,6 @@ library
-- This symbol is useful in gdb, but not referred to anywhere,
-- so we need to force it to be included in the binary.
ld-options: "-Wl,-u,findPtr"
- -- This symbol is useful in gdb, but not referred to anywhere,
- -- so we need to force it to be included in the binary.
- "-Wl,-u,findPtr"
if os(windows)
if flag(leading-underscore)
=====================================
testsuite/tests/simplStg/should_compile/T22212.hs
=====================================
@@ -0,0 +1,45 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+module T22212 where
+
+import GHC.Exts
+
+isNullAddr# :: Addr# -> (##)
+isNullAddr# a =
+ case eqAddr# a nullAddr# of
+ 1# -> (##)
+ _ -> compareBytes (##)
+{-# INLINE isNullAddr# #-}
+
+compareBytes :: (##) -> (##)
+compareBytes _ = (##)
+{-# NOINLINE compareBytes #-}
+
+mArray :: forall {rep :: RuntimeRep} {res :: TYPE rep}
+ . ( () -> () -> () -> () -> ()
+ -> () -> () -> () -> () -> ()
+ -> () -> () -> () -> () -> ()
+ -> () -> () -> () -> () -> ()
+ -> () -> () -> () -> () -> ()
+ -> res )
+ -> res
+mArray cont =
+ case isNullAddr# nullAddr# of
+ (##) ->
+ cont
+ () () () () ()
+ () () () () ()
+ () () () () ()
+ () () () () ()
+ () () () () ()
+ -- As of writing this test,
+ -- 9 arguments were required to trigger the bug.
+
+{-
+Original reproducer:
+
+data Sort = MkSort BS.ByteString [()]
+
+pattern Array :: () -> () -> Sort
+pattern Array x y = MkSort "Array" [x,y]
+-}
\ No newline at end of file
=====================================
testsuite/tests/simplStg/should_compile/all.T
=====================================
@@ -12,3 +12,5 @@ setTestOpts(f)
test('T13588', [ grep_errmsg('case') ] , compile, ['-dverbose-stg2stg -fno-worker-wrapper'])
test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typeable-binds'])
test('inferTags002', [ only_ways(['optasm']), grep_errmsg('(call stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O'])
+
+test('T22212', normal, compile, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb6d299865968d0a8f559668d3c809ce887ed9a7...fe5ab480fe7ba77d49626bff40685cb5c3749519
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb6d299865968d0a8f559668d3c809ce887ed9a7...fe5ab480fe7ba77d49626bff40685cb5c3749519
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220921/0f1f36fd/attachment-0001.html>
More information about the ghc-commits
mailing list