[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Handle promoted data constructors in typeToLHsType correctly
Marge Bot
gitlab at gitlab.haskell.org
Thu Apr 9 01:16:42 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
7802fa17 by Ryan Scott at 2020-04-08T16:43:44-04:00
Handle promoted data constructors in typeToLHsType correctly
Instead of using `nlHsTyVar`, which hardcodes `NotPromoted`, have
`typeToLHsType` pick between `Promoted` and `NotPromoted` by checking
if a type constructor is promoted using `isPromotedDataCon`.
Fixes #18020.
- - - - -
6f5d3937 by Ben Gamari at 2020-04-08T21:16:29-04:00
hadrian: Use --export-dynamic when linking iserv
As noticed in #17962, the make build system currently does this (see
3ce0e0ba) but the change was never ported to Hadrian.
- - - - -
46345c33 by Ben Gamari at 2020-04-08T21:16:29-04:00
iserv: Don't pass --export-dynamic on FreeBSD
This is definitely a hack but it's probably the best we can do for now.
Hadrian does the right thing here by passing --export-dynamic only to
the linker.
- - - - -
e8e100ea by Sylvain Henry at 2020-04-08T21:16:34-04:00
Rts: show errno on failure (#18033)
- - - - -
7 changed files:
- compiler/GHC/Hs/Utils.hs
- hadrian/src/Settings/Packages.hs
- rts/posix/itimer/Pthread.c
- testsuite/tests/deriving/should_compile/T14578.stderr
- testsuite/tests/deriving/should_compile/T14579.stderr
- testsuite/tests/deriving/should_fail/T15073.stderr
- utils/iserv/ghc.mk
Changes:
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -113,6 +113,7 @@ import GHC.Tc.Types.Evidence
import GHC.Types.Name.Reader
import GHC.Types.Var
import GHC.Core.TyCo.Rep
+import GHC.Core.TyCon
import GHC.Core.Type ( appTyArgFlags, splitAppTys, tyConArgFlags, tyConAppNeedsKindSig )
import TysWiredIn ( unitTy )
import GHC.Tc.Utils.TcType
@@ -686,7 +687,11 @@ typeToLHsType ty
| otherwise = ty'
where
ty' :: LHsType GhcPs
- ty' = go_app (nlHsTyVar (getRdrName tc)) args (tyConArgFlags tc args)
+ ty' = go_app (noLoc $ HsTyVar noExtField prom $ noLoc $ getRdrName tc)
+ args (tyConArgFlags tc args)
+
+ prom :: PromotionFlag
+ prom = if isPromotedDataCon tc then IsPromoted else NotPromoted
go ty@(AppTy {}) = go_app (go head) args (appTyArgFlags head args)
where
head :: Type
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -122,6 +122,14 @@ packageArgs = do
[ notStage0 ? builder (Cabal Flags) ? arg "ghci"
, cross ? stage0 ? builder (Cabal Flags) ? arg "ghci" ]
+ --------------------------------- iserv --------------------------------
+ -- Add -Wl,--export-dynamic enables GHCi to load dynamic objects that
+ -- refer to the RTS. This is harmless if you don't use it (adds a bit
+ -- of overhead to startup and increases the binary sizes) but if you
+ -- need it there's no alternative.
+ , package iserv ? mconcat
+ [ builder (Ghc LinkHs) ? arg "-optl-Wl,--export-dynamic" ]
+
-------------------------------- haddock -------------------------------
, package haddock ?
builder (Cabal Flags) ? arg "in-ghc-tree"
=====================================
rts/posix/itimer/Pthread.c
=====================================
@@ -110,13 +110,13 @@ static void *itimer_thread_func(void *_handle_tick)
timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC);
if (timerfd == -1) {
- barf("timerfd_create");
+ barf("timerfd_create: %s", strerror(errno));
}
if (!TFD_CLOEXEC) {
fcntl(timerfd, F_SETFD, FD_CLOEXEC);
}
if (timerfd_settime(timerfd, 0, &it, NULL)) {
- barf("timerfd_settime");
+ barf("timerfd_settime: %s", strerror(errno));
}
#endif
@@ -124,7 +124,7 @@ static void *itimer_thread_func(void *_handle_tick)
if (USE_TIMERFD_FOR_ITIMER) {
if (read(timerfd, &nticks, sizeof(nticks)) != sizeof(nticks)) {
if (errno != EINTR) {
- barf("Itimer: read(timerfd) failed");
+ barf("Itimer: read(timerfd) failed: %s", strerror(errno));
}
}
} else {
@@ -170,7 +170,7 @@ initTicker (Time interval, TickProc handle_tick)
pthread_setname_np(thread, "ghc_ticker");
#endif
} else {
- barf("Itimer: Failed to spawn thread");
+ barf("Itimer: Failed to spawn thread: %s", strerror(errno));
}
}
@@ -204,7 +204,7 @@ exitTicker (bool wait)
// wait for ticker to terminate if necessary
if (wait) {
if (pthread_join(thread, NULL)) {
- sysErrorBelch("Itimer: Failed to join");
+ sysErrorBelch("Itimer: Failed to join: %s", strerror(errno));
}
closeMutex(&mutex);
closeCondition(&start_cond);
=====================================
testsuite/tests/deriving/should_compile/T14578.stderr
=====================================
@@ -9,7 +9,7 @@ Derived class instances:
GHC.Base.sconcat ::
GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a
GHC.Base.stimes ::
- forall (b :: TYPE GHC.Types.LiftedRep).
+ forall (b :: TYPE 'GHC.Types.LiftedRep).
GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a
(GHC.Base.<>)
= GHC.Prim.coerce
@@ -37,12 +37,12 @@ Derived class instances:
instance GHC.Base.Functor f =>
GHC.Base.Functor (T14578.App f) where
GHC.Base.fmap ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: TYPE 'GHC.Types.LiftedRep)
+ (b :: TYPE 'GHC.Types.LiftedRep).
(a -> b) -> T14578.App f a -> T14578.App f b
(GHC.Base.<$) ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: TYPE 'GHC.Types.LiftedRep)
+ (b :: TYPE 'GHC.Types.LiftedRep).
a -> T14578.App f b -> T14578.App f a
GHC.Base.fmap
= GHC.Prim.coerce
@@ -56,23 +56,23 @@ Derived class instances:
instance GHC.Base.Applicative f =>
GHC.Base.Applicative (T14578.App f) where
GHC.Base.pure ::
- forall (a :: TYPE GHC.Types.LiftedRep). a -> T14578.App f a
+ forall (a :: TYPE 'GHC.Types.LiftedRep). a -> T14578.App f a
(GHC.Base.<*>) ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: TYPE 'GHC.Types.LiftedRep)
+ (b :: TYPE 'GHC.Types.LiftedRep).
T14578.App f (a -> b) -> T14578.App f a -> T14578.App f b
GHC.Base.liftA2 ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep)
- (c :: TYPE GHC.Types.LiftedRep).
+ forall (a :: TYPE 'GHC.Types.LiftedRep)
+ (b :: TYPE 'GHC.Types.LiftedRep)
+ (c :: TYPE 'GHC.Types.LiftedRep).
(a -> b -> c) -> T14578.App f a -> T14578.App f b -> T14578.App f c
(GHC.Base.*>) ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: TYPE 'GHC.Types.LiftedRep)
+ (b :: TYPE 'GHC.Types.LiftedRep).
T14578.App f a -> T14578.App f b -> T14578.App f b
(GHC.Base.<*) ::
- forall (a :: TYPE GHC.Types.LiftedRep)
- (b :: TYPE GHC.Types.LiftedRep).
+ forall (a :: TYPE 'GHC.Types.LiftedRep)
+ (b :: TYPE 'GHC.Types.LiftedRep).
T14578.App f a -> T14578.App f b -> T14578.App f a
GHC.Base.pure
= GHC.Prim.coerce
=====================================
testsuite/tests/deriving/should_compile/T14579.stderr
=====================================
@@ -8,16 +8,16 @@ Derived class instances:
T14579.Glurp a -> T14579.Glurp a -> GHC.Types.Bool
(GHC.Classes.==)
= GHC.Prim.coerce
- @(T14579.Wat @a (Data.Proxy.Proxy @a)
- -> T14579.Wat @a (Data.Proxy.Proxy @a) -> GHC.Types.Bool)
+ @(T14579.Wat @a ('Data.Proxy.Proxy @a)
+ -> T14579.Wat @a ('Data.Proxy.Proxy @a) -> GHC.Types.Bool)
@(T14579.Glurp a -> T14579.Glurp a -> GHC.Types.Bool)
- ((GHC.Classes.==) @(T14579.Wat @a (Data.Proxy.Proxy @a)))
+ ((GHC.Classes.==) @(T14579.Wat @a ('Data.Proxy.Proxy @a)))
(GHC.Classes./=)
= GHC.Prim.coerce
- @(T14579.Wat @a (Data.Proxy.Proxy @a)
- -> T14579.Wat @a (Data.Proxy.Proxy @a) -> GHC.Types.Bool)
+ @(T14579.Wat @a ('Data.Proxy.Proxy @a)
+ -> T14579.Wat @a ('Data.Proxy.Proxy @a) -> GHC.Types.Bool)
@(T14579.Glurp a -> T14579.Glurp a -> GHC.Types.Bool)
- ((GHC.Classes./=) @(T14579.Wat @a (Data.Proxy.Proxy @a)))
+ ((GHC.Classes./=) @(T14579.Wat @a ('Data.Proxy.Proxy @a)))
instance forall a (x :: Data.Proxy.Proxy a).
GHC.Classes.Eq a =>
=====================================
testsuite/tests/deriving/should_fail/T15073.stderr
=====================================
@@ -3,7 +3,7 @@ T15073.hs:8:12: error:
• Illegal unboxed tuple type as function argument: (# Foo a #)
Perhaps you intended to use UnboxedTuples
• In the type signature:
- p :: Foo a -> Unit# @GHC.Types.LiftedRep (Foo a)
+ p :: Foo a -> Unit# @'GHC.Types.LiftedRep (Foo a)
When typechecking the code for ‘p’
in a derived instance for ‘P (Foo a)’:
To see the code I am typechecking, use -ddump-deriv
=====================================
utils/iserv/ghc.mk
=====================================
@@ -30,8 +30,9 @@ endif
# refer to the RTS. This is harmless if you don't use it (adds a bit
# of overhead to startup and increases the binary sizes) but if you
# need it there's no alternative.
+# Don't do this on FreeBSD to work around #17962.
ifeq "$(TargetElf)" "YES"
-ifneq "$(TargetOS_CPP)" "solaris2"
+ifeq "$(findstring $(TargetOS_CPP), solaris2 freebsd)" ""
# The Solaris linker does not support --export-dynamic option. It also
# does not need it since it exports all dynamic symbols by default
utils/iserv_stage2_MORE_HC_OPTS += -optl-Wl,--export-dynamic
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ff8d3604b3dc946f968347aa524a4436efee18d...e8e100ead0c5d8c7d12ae3079ed6f5f0307ed073
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ff8d3604b3dc946f968347aa524a4436efee18d...e8e100ead0c5d8c7d12ae3079ed6f5f0307ed073
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/20200408/748fbce2/attachment-0001.html>
More information about the ghc-commits
mailing list